perm filename LINE.FND[SYS,HE]1 blob
sn#056756 filedate 1973-08-05 generic text, type T, neo UTF8
00100
00200 ⊃ Here we declare some arrays that are used by several procedures
00300 and some parameters which are set in INITIAL;
00400
00500
00600
00700 SHORT INTEGER ARRAY HIST[-5:510];
00800 SHORT REAL ARRAY PEAKS[0:30];
00900 DEFINE LINEPTS(I) = { EDGES[EDGE_LIMIT-(I)] };
01000 SHORT REAL THFACTOR,CFACTOR,NDC2,NDTH2,NDS3,NDS32;
01100 SHORT INTEGER NMIN,NPEAKS,NHUMPS,NVERT,MINHUMPS,RMAX;
01200 SHORT INTEGER MAXRES,MINRES,NHIGH_1,FLAG;
01300 SHORT INTEGER MAXT,MAXC,MAXR,MAXDR,RHIGH,BIT_FACTOR;
01400 SHORT INTEGER INDEX, EI, L_INDEX, F_INDEX, LINE_INDEX;
01500 SHORT REAL NDRAD,NDRSQ;
01600
01700
01800
01900 DEFINE PTH =EDGE_TH -EBS+1, PC=EDGE_C -EBS+1,
02000 POPX=EDGE_X-EBS+1, POPY=EDGE_Y-EBS+1;
02100
02200 DEFINE PI32={(1.5*PI1)};
02300
02400 DEFINE FPOINT={20},THET={1},CEE={2},SIGNX={11},SIGNY={12},
02500 CHIVALUE={7},VERTGAP={10},
02600 VERT_END=FPOINT-2, DIRSIN=FPOINT-1, DIRCOS=FPOINT;
02700
02800
02900 SIMPLE INTEGER PROCEDURE SIGN(REAL X);
03000 RETURN(X/ABS(X));
03100
03200
03300
03400
03500 SIMPLE REAL PROCEDURE GET_ANGLE(SHORT REAL CX,CY);
03600
03700 ⊃ Here we return the angle defined by delta-x and delta-y;
03800
03900 BEGIN
04000 SHORT REAL PHI;
04100 IF ABS(CX) ≥.10@-8 THEN
04200 BEGIN
04300 PHI ← ATAN(CY/CX);
04400 IF CX<0 THEN PHI←PHI+PI1;
04500 END ELSE
04600 IF CY≥0 THEN PHI ← PIO2 ELSE PHI ← -PIO2;
04700 RETURN(PHI);
04800 END;
04900
05000
05100
05200 SIMPLE REAL PROCEDURE LINE_INT(REAL SINTH1,COSTH1,C1,SINTH2,COSTH2,C2;
05300 REFERENCE REAL X,Y);
05400 BEGIN
05500 X←(C2*SINTH1-C1*SINTH2)/(COSTH1*SINTH2-SINTH1*COSTH2);
05600 Y←(C2*COSTH1-C1*COSTH2)/(SINTH1*COSTH2-COSTH1*SINTH2);
05700 END "LINE_INT";
05800
05900
06000 SIMPLE REAL PROCEDURE XINTERSECT(SHORT REAL X; SHORT INTEGER L);
06100 IF ABS(HUMPS[L,SINTHETA])<.10@-6 THEN RETURN(-1000.) ELSE
06200 RETURN(-(X*HUMPS[L,COSTHETA]+HUMPS[L,CEE])/HUMPS[L,SINTHETA]);
06300
06400
06500
06600 SIMPLE REAL PROCEDURE YINTERSECT(SHORT REAL Y; SHORT INTEGER L);
06700 IF ABS(HUMPS[L,COSTHETA])<.10@-6 THEN RETURN(-1000.) ELSE
06800 RETURN(-(Y*HUMPS[L,SINTHETA]+HUMPS[L,CEE])/HUMPS[L,COSTHETA]);
06900
07000
07100 SIMPLE BOOLEAN PROCEDURE CIR_INTERSECT(REFERENCE REAL XX1,XX2;
07200 SHORT REAL Y,XC,YC,RAD);
07300 BEGIN
07400 SHORT REAL TEMP;
07500 IF (TEMP←RAD*RAD-(Y-YC)↑2)<0 THEN RETURN(0);
07600 TEMP←SQRT(TEMP);
07700 XX2←XC+TEMP;
07800 XX1←XC-TEMP;
07900 RETURN(-1);
08000 END;
08100
08200
08300 SIMPLE BOOLEAN PROCEDURE ARC_INTERSECT(REFERENCE REAL XX1,XX2;
08400 SHORT REAL Y,XC,YC,RAD,THETA_1,THETA_2);
08500 BEGIN
08600 SHORT REAL TEMP,THETA;
08700 IF (TEMP←RAD*RAD-(Y-YC)↑2)<0 THEN RETURN(0);
08800 TEMP←SQRT(TEMP);
08900 XX2←XC+TEMP;
09000 XX1←XC-TEMP;
09100 THETA←GET_ANGLE(XC-XX1,YC-Y);
09200 IF THETA<THETA_1 THEN THETA←THETA+PIT2;
09300 IF THETA>THETA_2 THEN
09400 BEGIN
09500 THETA←THETA-PIT2;
09600 IF THETA<THETA_1 THEN XX1←-1;
09700 END;
09800 THETA←GET_ANGLE(XC-XX2,YC-Y);
09900 IF THETA<THETA_1 THEN THETA←THETA+PIT2;
10000 IF THETA>THETA_2 THEN
10100 BEGIN
10200 THETA←THETA-PIT2;
10300 IF THETA<THETA_1 THEN XX2←-1;
10400 END;
10500 IF XX1<0∧XX2<0 THEN RETURN(0);
10600 IF XX1<0 THEN XX1←XX2;
10700 RETURN(-1);
10800 END;
10900
00100
00200
00300 SIMPLE PROCEDURE PUT_IN_ORDER(SHORT REAL ARRAY XX; SHORT INTEGER MAX);
00400
00500 ⊃ Here we put the numbers in array XX in increasing order;
00600
00700 BEGIN
00800 SHORT INTEGER I,ISAVE,LOWEST;
00900 SHORT REAL MIN;
01000 LABEL AGAIN;
01100 LOWEST←1;
01200 AGAIN: MIN←10000.;
01300 FOR I←LOWEST STEP 1 UNTIL MAX DO
01400 IF XX[I]<MIN THEN
01500 BEGIN
01600 MIN←XX[I];
01700 ISAVE←I;
01800 END;
01900 XX[ISAVE]↔XX[LOWEST];
02000 LOWEST←LOWEST+1;
02100 IF LOWEST<MAX THEN GO TO AGAIN;
02200 END;
02300
02400
02500
02600 SIMPLE REAL PROCEDURE SMALLER(REAL L1,L2);
02700 IF L1<L2 THEN RETURN(L1) ELSE RETURN(L2);
02800
02900 SIMPLE REAL PROCEDURE LARGER(REAL L1,L2);
03000 IF L1>L2 THEN RETURN(L1) ELSE RETURN(L2);
03100
03200
03300 SIMPLE REAL PROCEDURE SMALLEST(SHORT REAL X1,X2,X3);
03400 IF X1≤X2∧X1≤X3 THEN RETURN(X1) ELSE
03500 IF X2≤X1∧X2≤X3 THEN RETURN(X2) ELSE
03600 RETURN(X3);
03700
03800
03900
04000 SIMPLE REAL PROCEDURE LARGEST(SHORT REAL X1,X2,X3);
04100 IF X1≥X2∧X1≥X3 THEN RETURN(X1) ELSE
04200 IF X2≥X1∧X2≥X3 THEN RETURN(X2) ELSE
04300 RETURN(X3);
04400
04500
04600
04700 SIMPLE REAL PROCEDURE LENGTHSQ(SHORT INTEGER N);
04800 RETURN((HUMPS[N,FPOINT+1]-HUMPS[N,HUMPS[N,6]+1])↑2
04900 +(HUMPS[N,FPOINT+2]-HUMPS[N,HUMPS[N,6]+2])↑2);
05000
05100 DEFINE INTERSECT(L,K)= {LINE_INT(HUMPS[L,SINTHETA],HUMPS[L,COSTHETA],
05200 HUMPS[L,CEE],HUMPS[K,SINTHETA],HUMPS[K,COSTHETA],
05300 HUMPS[K,CEE],X,Y)};
05400
05500
00100
00200
00300
00400 BOOLEAN PROCEDURE VERT_THREE(SHORT INTEGER N,J1,J2;
00500 REFERENCE REAL X,Y,VERT_GAP);
00600
00700 ⊃ Here we see if the 3 lines N, J1, J2 form a vertex. In either
00800 case we return the location X,Y, and the largest perpendicular
00900 distance of a line from the intersection point;
01000
01100 BEGIN "VER"
01200 SHORT INTEGER I;
01300 SHORT REAL DN,DJ1,DJ2,SUMSINSQ,SUMCOSSQ,SUMSINCOS,SUMCSIN,SUMCCOS,DEN;
01400
01500 SUMSINSQ←SUMCOSSQ←SUMSINCOS←SUMCSIN←SUMCCOS←0;
01600 FOR I←N,J1,J2 DO
01700 BEGIN
01800 SUMSINSQ←SUMSINSQ+HUMPS[I,SINTHETA]↑2;
01900 SUMCOSSQ←SUMCOSSQ+HUMPS[I,COSTHETA]↑2;
02000 SUMSINCOS←SUMSINCOS+HUMPS[I,SINTHETA]*HUMPS[I,COSTHETA];
02100 SUMCCOS←SUMCCOS+HUMPS[I,CEE]*HUMPS[I,COSTHETA];
02200 SUMCSIN←SUMCSIN+HUMPS[I,CEE]*HUMPS[I,SINTHETA];
02300 END;
02400 DEN←SUMSINCOS↑2-SUMCOSSQ*SUMSINSQ;
02500 X←(SUMSINSQ*SUMCCOS-SUMSINCOS*SUMCSIN)/DEN;
02600 Y←(SUMCOSSQ*SUMCSIN-SUMSINCOS*SUMCCOS)/DEN;
02700 DN←ABS(X*HUMPS[N,COSTHETA]+Y*HUMPS[N,SINTHETA]+HUMPS[N,CEE]);
02800 DJ1←ABS(X*HUMPS[J1,COSTHETA]+Y*HUMPS[J1,SINTHETA]+HUMPS[J1,CEE]);
02900 DJ2←ABS(X*HUMPS[J2,COSTHETA]+Y*HUMPS[J2,SINTHETA]+HUMPS[J2,CEE]);
03000 VERT_GAP←LARGEST(DN,DJ1,DJ2);
03100 IF VERT_GAP>NDACC THEN RETURN(0) ELSE RETURN(-1);
03200 END "VER";
03300
03400
00100
00200 PROCEDURE ORDER(SHORT INTEGER F);
00300 BEGIN "ORD"
00400 SHORT REAL MIN,TEMP;
00500 SHORT INTEGER I,J,ISAVE,MAX,XY,LOWEST;
00600 LABEL AGAIN;
00700 IF ABS(HUMPS[F,9])>0.5 THEN XY←0 ELSE XY←1;
00800 MAX←HUMPS[F,6]+1; LOWEST←FPOINT+1;
00900 ⊃ OUTSTR(CRLF"XY="&CVS(XY)&" MAX="&CVS(MAX)&" LOWEST="&CVS(LOWEST)
01000 &" SIN="&CVG(HUMPS[F,9]));
01100
01200 FOR I←1 STEP 1 UNTIL HUMPS[F,6]+4 DO
01300 ⊃ OUTSTR(CRLF&" I="&CVS(I)&" HUMPS[F,I]="&CVG(HUMPS[F,I]));
01400 AGAIN: MIN←10000.;
01500 FOR I←LOWEST STEP 3 UNTIL MAX DO
01600 IF HUMPS[F,I+XY]<MIN THEN
01700 BEGIN
01800 ISAVE←I;
01900 MIN←HUMPS[F,I+XY];
02000 END;
02100 IF ISAVE≠LOWEST THEN
02200 FOR J←0 STEP 1 UNTIL 2 DO
02300 BEGIN
02400 TEMP←HUMPS[F,ISAVE+J];
02500 HUMPS[F,ISAVE+J]←HUMPS[F,LOWEST+J];
02600 HUMPS[F,LOWEST+J]←TEMP;
02700 END;
02800 LOWEST←LOWEST+3;
02900 IF LOWEST<MAX THEN GO TO AGAIN;
03000 ⊃ FOR I←1 STEP 1 UNTIL HUMPS[F,6]+4 DO
03100 ⊃ OUTSTR(CRLF&" I="&CVS(I)&" HUMPS[F,I]="&CVG(HUMPS[F,I]));
03200 END "ORD";
03300
00100
00200
00300 SIMPLE PROCEDURE LINE_DISP(INTEGER N);
00400
00500 ⊃ Here we display line "N" which is stored in array humps. Also an arrow
00600 and "L(N) are displayed;
00700
00800 BEGIN "LDISP"
00900 SHORT REAL X1,Y1,X2,Y2,SINTH,COSTH,ABSIN,ABCOS,DELTA,DX,DY,GAP;
01000 SHORT REAL XC,YC,XARROW,YARROW;
01100 SHORT INTEGER JHUMP,GAPN,I,J,SGNX,SGNY;
01200 LABEL NUM_LINE;
01300 XC←(HUMPS[N,FPOINT+1]+HUMPS[N,HUMPS[N,6]+1])/2.;
01400 YC←(HUMPS[N,FPOINT+2]+HUMPS[N,HUMPS[N,6]+2])/2.;
01500 XARROW←XC; YARROW←YC;
01600 SINTH←HUMPS[N,SINTHETA];
01700 COSTH←HUMPS[N,COSTHETA];
01800 ABSIN←ABS(SINTH);
01900 ABCOS←ABS(COSTH);
02000 DELTA←1.3;
02100 SGNX←HUMPS[N,11];
02200 SGNY←HUMPS[N,12];
02300 ⊃ OUTSTR(CRLF&"SIGN X="&CVS(SGNX)&" SIGN Y="&CVS(SGNY));
02400 DX←SGNX*DELTA*ABSIN;
02500 DY←SGNY*DELTA*ABCOS;
02600 IF HUMPS[N,13]>0 THEN
02700 BEGIN
02800 AIVECT(TX(HUMPS[N,13]),TY(HUMPS[N,14]));
02900 IF HUMPS[N,15]>0 THEN GO TO NUM_LINE ELSE
03000 AVECT(TX(HUMPS[N,FPOINT+1]),TY(HUMPS[N,FPOINT+2]));
03100 END;
03200 JHUMP←FPOINT;
03300 ⊃ OUTSTR(CRLF&" X="&CVG(HUMPS[N,JHUMP+1])&" Y="&CVG(HUMPS[N,JHUMP+2]));
03400 AIVECT(TX(HUMPS[N,JHUMP+1]),TY(HUMPS[N,JHUMP+2]));
03500 FOR I←2 STEP 1 UNTIL HUMPS[N,5] DO
03600 BEGIN
03700 JHUMP←JHUMP+3;
03800 ⊃ OUTSTR(CRLF&" X="&CVG(HUMPS[N,JHUMP+1])&" Y="&CVG(HUMPS[N,JHUMP+2]));
03900 IF HUMPS[N,JHUMP] THEN BEGIN
04000 X1←HUMPS[N,JHUMP+1]; Y1←HUMPS[N,JHUMP+2];
04100 AVECT(TX(X1),TY(Y1)); END
04200 ELSE
04300 BEGIN
04400 IF ABSIN>0.5 THEN
04500 GAP←(HUMPS[N,JHUMP+1]-HUMPS[N,JHUMP-2])/ABSIN
04600 ELSE
04700 GAP←(HUMPS[N,JHUMP+2]-HUMPS[N,JHUMP-1])/ABCOS;
04800 GAPN←ABS(GAP)/(2.*DELTA);
04900 ⊃ OUTSTR(CRLF&" GAP = "&CVG(GAP)
05000 &" GAPN = "&CVS(GAPN));
05100 FOR J←1 STEP 1 UNTIL GAPN DO
05200 BEGIN
05300 ⊃ OUTSTR(CRLF&" DX="&CVG(DX)&" DY="&CVG(DY));
05400 X1←X1+DX; Y1←Y1+DY;
05500 AIVECT(TX(X1),TY(Y1));
05600 X1←X1+DX; Y1←Y1+DY;
05700 AVECT(TX(X1),TY(Y1));
05800 END;
05900 END;
06000 END;
06100 IF HUMPS[N,15]>0 THEN
06200 NUM_LINE: AVECT(TX(HUMPS[N,15]),TY(HUMPS[N,16]));
06300 IF ABSIN>0.5 THEN BEGIN YARROW←YC+3;YC←YC-4 END
06400 ELSE BEGIN
06500 XARROW←XC+3;
06600 IF CAL_COMP THEN XC←XC-16*EDGE_LIMIT/4000.
06700 ELSE XC←XC-9;
06800 END;
06900 AIVECT(TX(XC),TY(YC));
07000 IF CAL_COMP THEN DPYBIG(6);
07100 DPYSST("L"&CVS(N));
07200 IF ¬CAL_COMP THEN ARROW(XARROW,YARROW,DX,DY);
07300 END "LDISP";
07400
07500
07600
07700 PROCEDURE SHOW;
07800 BEGIN
07900 SHORT INTEGER J;
08000 FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
08100 LINE_DISP(J);
08200 DPYOUT(1);
08300 END "SHOW";
08400
08500
08600 SIMPLE PROCEDURE SHOW_LINES;
08700 BEGIN
08800 SHORT INTEGER J;
08900 DPYSET(BUF);
09000 BOUNDARY(X1,Y2,X2,Y1);
09100 FOR J←0 STEP 1 UNTIL NLINES-1 DO
09200 LINE_DISP(J);
09300 DPYOUT(1);
09400 END;
09500
09600 PROCEDURE SHOWCIR(SHORT REAL XC,YC,NDRAD);
09700 BEGIN
09800 SHORT INTEGER J;
09900
10000
10100 DPYSET(BUF);
10200 BOUNDARY(X1,Y2,X2,Y1);
10300 FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
10400 LINE_DISP(J);
10500 MKCIRCLE(NDRAD*SCAL,TX(XC),TY(YC),25);
10600 DPYOUT(1);
10700 END;
00100
00200
00300 ⊃ Here we call the edge operator;
00400 INTEGER PROCEDURE EDGE_FIND(SHORT INTEGER X1,Y1,X2,Y2);
00500 begin "edge_find"
00600 BOOLEAN DEBUGT;
00700 SHORT REAL OP_CX,OP_CY,OP_OPX,OP_OPY,OP_OPXM,OP_OPYM,OP_OPXP,OP_OPYP;
00800 SHORT REAL OP_TM,OP_B,OP_TP;
00900 REAL C, PHI, THETA, DXY;
01000 SHORT INTEGER OP_X,OP_Y; ⊃ POINT OF APPLICATION OF THE EDGE OPERATOR;
01100 SHORT INTEGER OP_DEBUG; ⊃ FLAG FOR OP PRINT;
01200 SHORT INTEGER nbits,nwords;
01300
01400 SHORT INTEGER rows,columns,LIMIT;
01500 SHORT INTEGER xr,yr;
01600 SHORT INTEGER x,y,sx;
01700 LABEL LOOK1,LAST;
01800
01900 procedure op_save;
02000 begin
02100 op_opx←opx;op_opy←opy;
02200 op_cx←cx;op_cy←cy;
02300 op_opxp←opxp;op_opxm←opxm;
02400 op_opyp←opyp;op_opym←opym;
02500 op_tm←tm;op_tp←tp;
02600 op_b←b;
02700 op_x←x;op_y←y;
02800 end;
02900
03000 procedure op_restore;
03100 begin
03200 opx←op_opx;opy←op_opy;
03300 cx←op_cx;cy←op_cy;
03400 opxm←op_opxm;opxp←op_opxp;
03500 opym←op_opym;opyp←op_opyp;
03600 tm←op_tm;tp←op_tp;
03700 b←op_b;
03800 xr←op_x;yr←op_y;
03900 end;
04000
04100
04200
04300 LOOK1: rows←y2-y1+1;
04400 columns←x2-x1+1;
04500 ⊃ OUTSTR(CRLF&" IN EDGE_FIND ROWS="&CVS(ROWS)&" COLUMNS="&CVS(COLUMNS));
04600 LIMIT←EDGE_LIMIT-5*EDGE_BLSIZE;
04700 nbits←rows*columns;
04800 nwords←nbits DIV 36;
04900 EDGE_COUNT ← 1;
05000 EDGE_INDEX ← 0;
05100 if nbits MOD 36 then nwords←nwords+1;
05200 BEGIN "SHOW1"
05300 SHORT INTEGER ptr1;
05400 SHORT INTEGER_array edge_bits[1:nwords];
05500 for x←1 step 1 until nwords do edge_bits[x]←0;
05600
05700 for y←y1+2 step 2 until y2-2 do
05800 begin "CLX"
05900 if (y land 2)≠0 then sx←x1+2
06000 else sx←x1+3;
06100 ⊃ Here we start the edge scan and display the results;
06200
06300 for x←sx step 2 until x2-2 do begin "xscan"
06400 LABEL AWAY,T1,T2,T3,T4,T5;
06500 SHORT INTEGER wd;
06600 SHORT REAL u;
06700 ⊃ OUTSTR(CRLF&" X="&CVS(X)&" Y="&CVS(Y));
06800 T1: if EJLI(x,y,0,0) ∧ ¬bcomp then begin "store"
06900 SHORT REAL v;
07000 label resume;
07100 ⊃ if debugt then
07200 outstr(crlf&" success "&cvs(x)&" "&cvs(y)&" ");
07300 T2: v←sqrt((opx-x)↑2+(opy-y)↑2)/abs(tm+tp);
07400 xr←opx+0.5;yr←opy+0.5;
07500 if xr=x ∧ yr=y then go to resume;
07600 ⊃ if debugt then outstr(" xr "&cvs(xr)&" "&cvs(yr));
07700 op_save;
07800 T3: if ((¬EJLI(xr,yr,0,0))∨bcomp)
07900 ∨(u←((opx-xr)↑2+(opy-yr)↑2)>1.0) then op_restore
08000 else if v<sqrt(u)/abs(tm+tp)
08100 then op_restore;
08200 resume:
08300 ⊃ use a bit matrix to test whether
08400 we have tried here before;
08500 T4: nbits←(xr-X1)+(yr-Y1)*columns;
08600 nwords←nbits div 36;
08700 nbits←nbits mod 36;
08800 if nbits≠0 then nwords←nwords+1;
08900 nbits← 1 LSH nbits;
09000 wd←edge_bits[nwords] LAND nbits;
09100 if wd≠0∨((opx-xr)↑2+(opy-yr)↑2)>1.0 then begin
09200 ⊃ if debugt then outstr(crlf&" killed "&cvs(xr)&" "&cvs(yr)&" ");
09300 go to away;end;
09400 edge_bits[nwords]←edge_bits[nwords] LOR nbits;
09500 IF ABS(CX) ≥.10@-8 THEN
09600 BEGIN
09700 PHI ← ATAN(CY/CX);
09800 IF CX<0 THEN PHI←PHI+PI1;
09900 END ELSE
10000 IF CY≥0 THEN PHI ← PIO2 ELSE PHI ← -PIO2;
10100 THETA ← PHI +PI1;
10200 C ← -OPX*COS(THETA) -OPY*SIN(THETA);
10300 ⊃ OUTSTR(CRLF&"PHI = " &CVG(PHI)
10400 &" X="&CVG(OPX)
10500 &" Y="&CVG(OPY)
10600 &"THETA = " &CVG(THETA)
10700 &" SINTH="&CVG(SIN(THETA))
10800 &" COSTH="&CVG(COS(THETA))
10900 &"C = " &CVG(C));
11000 edges[edge_count+edge_x]←opx;
11100 edges[edge_count+edge_y]←opy;
11200 EDGES[EDGE_COUNT+EDGE_TH]←THETA;
11300 EDGES[EDGE_COUNT+EDGE_C]←C;
11400 edge_index←edge_index+1;
11500 edge_count←edge_count+edge_blsize;
11600 end "store";
11700 IF EDGE_COUNT>LIMIT THEN RETURN(Y);
11800 away:
11900 end "xscan";
12000 end "CLX";
12100 END "SHOW1";
12200 edge_count←edge_count-edge_blsize;
12300 IF DIS_EYE THEN
12400 BEGIN
12500 EDGE_DISP(0,EDGE_INDEX,X1,Y1,X2,Y2,EDGES);
12600 DPYOUT(1);
12700 IF CAL2_COMP THEN CALCOMP("NEWEDG",BUF)
12800 ELSE IF CAL_COMP THEN CALCOMP("EDGES",BUF);
12900 END;
13000 LAST: RETURN(-1);
13100 END "edge_find";
00100 ⊃ Here we call the edge operator;
00200 ⊃ This procedure is used to scan rectanglar regions which are
00300 at an angle theta to the x-axis. DX = sin(theta) and DY = cos(theta),
00400 XC and YC are the center of the small-x side before rotation;
00500
00600 INTEGER PROCEDURE EDGE_SCAN(SHORT REAL XC,YC,DX,DY);
00700 BEGIN "SCAN_EDGE"
00800 BOOLEAN DEBUGT;
00900 SHORT REAL OP_CX,OP_CY,OP_OPX,OP_OPY,OP_OPXM,OP_OPYM,OP_OPXP,OP_OPYP;
01000 SHORT REAL OP_TM,OP_B,OP_TP;
01100 REAL C, PHI, THETA, DXY;
01200 SHORT INTEGER OP_X,OP_Y; ⊃ POINT OF APPLICATION OF THE EDGE OPERATOR;
01300 SHORT INTEGER OP_DEBUG; ⊃ FLAG FOR OP PRINT;
01400 SHORT INTEGER nbits,nwords;
01500 SHORT INTEGER X1,Y1,X2,Y2;
01600 SHORT INTEGER rows,columns,LIMIT,MAXN;
01700 SHORT INTEGER xr,yr,INTX,INTY;
01800 SHORT REAL XP,YP,DIFFSAVE;
01900
02000
02100 DEFINE DPARALLEL="15", DPERP="10",DEL="0", DSTEP="1";
02200
02300 SHORT INTEGER x,y,sx;
02400 LABEL LOOK1,LAST;
02500
02600 procedure op_save;
02700 begin
02800 op_opx←opx;op_opy←opy;
02900 op_cx←cx;op_cy←cy;
03000 op_opxp←opxp;op_opxm←opxm;
03100 op_opyp←opyp;op_opym←opym;
03200 op_tm←tm;op_tp←tp;
03300 op_b←b;
03400 op_x←XP;op_y←YP;
03500 end;
03600
03700 procedure op_restore;
03800 begin
03900 opx←op_opx;opy←op_opy;
04000 cx←op_cx;cy←op_cy;
04100 opxm←op_opxm;opxp←op_opxp;
04200 opym←op_opym;opyp←op_opyp;
04300 tm←op_tm;tp←op_tp;
04400 b←op_b;
04500 xr←op_x;yr←op_y;
04600 end;
04700
04800 DIFFSAVE←DIFF;
04900 DIFF←10.;
05000
05100 X1←XC-DY*DPERP/2.;
05200 Y1←YC+DX*DPERP/2.;
05300 X2←X1-DPARALLEL*DX+DPERP*DY;
05400 Y2←Y1-DPARALLEL*DY-DPERP*DX;
05500 ⊃ OUTSTR(CRLF&" X1="&CVG(X1)&
05600 " X2="&CVG(X2)&
05700 " Y1="&CVG(Y1)&
05800 " Y2="&CVG(Y2)&
05900 " DX="&CVG(DX)&
06000 " DY="&CVG(DY)ACRLF);
06100 LOOK1: ROWS←DPERP+1;
06200 COLUMNS←DPARALLEL+1;
06300 ⊃ OUTSTR(CRLF&" IN EDGE_FIND ROWS="&CVS(ROWS)&" COLUMNS="&CVS(COLUMNS));
06400 LIMIT←EDGE_LIMIT-5*EDGE_BLSIZE;
06500 nbits←rows*columns;
06600 nwords←nbits DIV 36;
06700 MAXN←NWORDS;
06800 EDGE_COUNT ← 1;
06900 EDGE_INDEX ← 0;
07000 if nbits MOD 36 then nwords←nwords+1;
07100 BEGIN "SHOW1"
07200 SHORT INTEGER ptr1;
07300 SHORT INTEGER ARRAY EDGE_BITS[-5:MAXN+10];
07400 for x←0 step 1 until nwords do edge_bits[x]←0;
07500
07600 FOR Y←DEL STEP DSTEP UNTIL DPERP-DEL DO
07700 begin "CLX"
07800 ⊃ Here we start the edge scan and display the results;
07900
08000 FOR X←DEL STEP DSTEP UNTIL DPARALLEL-DEL DO
08100 BEGIN "XSCAN"
08200 LABEL AWAY,T1,T2,T3,T4,T5,SAV;
08300 SHORT INTEGER wd;
08400 SHORT REAL u;
08500 XP←X1-X*DX+Y*DY;
08600 YP←Y1-X*DY-Y*DX;
08700 ⊃ OUTSTR(CRLF&" X="&CVS(X)&" Y="&CVS(Y)&" XP="&CVG(XP)&" YP="&CVG(YP));
08800 T1: IF EJLI(XP,YP,0,0) ∧ ¬BCOMP THEN
08900 begin "store"
09000 SHORT REAL v;
09100 label resume;
09200 ⊃ if debugt then
09300 outstr(crlf&" success "&cvs(XP)&" "&cvs(YP)&" ");
09400 T2: v←sqrt((opx-XP)↑2+(opy-YP)↑2)/abs(tm+tp);
09500 xr←opx+0.5;yr←opy+0.5;
09600 if xr=XP ∧ yr=YP then go to resume;
09700 ⊃ outstr(CRLF&" xr "&cvs(xr)&" "&cvs(yr));
09800 op_save;
09900 T3: if ((¬EJLI(xr,yr,0,0))∨bcomp)
10000 ∨(u←((opx-xr)↑2+(opy-yr)↑2)>1.0) then op_restore
10100 else if v<sqrt(u)/abs(tm+tp)
10200 then op_restore;
10300 resume:
10400 ⊃ use a bit matrix to test whether
10500 we have tried here before;
10600 T4: INTX←-DX*(XR-X1)-DY*(YR-Y1);
10700 INTY←DY*(XR-X1)-DX*(YR-Y1);
10800 NBITS←INTX+INTY*COLUMNS;
10900 nwords←nbits div 36;
11000 nbits←nbits mod 36;
11100 if nbits≠0 then nwords←nwords+1;
11200 nbits← 1 LSH nbits;
11300 IF NWORDS<0∨NWORDS>MAXN THEN GO TO SAV;
11400 wd←edge_bits[nwords] LAND nbits;
11500 if wd≠0∨((opx-xr)↑2+(opy-yr)↑2)>1.0 then begin
11600 ⊃ if debugt then outstr(crlf&" killed "&cvs(xr)&" "&cvs(yr)&" ");
11700 go to away;end;
11800 edge_bits[nwords]←edge_bits[nwords] LOR nbits;
11900 SAV: IF ABS(CX) ≥.10@-8 THEN
12000 BEGIN
12100 PHI ← ATAN(CY/CX);
12200 IF CX<0 THEN PHI←PHI+PI1;
12300 END ELSE
12400 IF CY≥0 THEN PHI ← PIO2 ELSE PHI ← -PIO2;
12500 THETA ← PHI +PI1;
12600 C ← -OPX*COS(THETA) -OPY*SIN(THETA);
12700 ⊃ OUTSTR(CRLF&"PHI = " &CVG(PHI)
12800 &" X="&CVG(OPX)
12900 &" Y="&CVG(OPY)
13000 &"THETA = " &CVG(THETA)
13100 &" SINTH="&CVG(SIN(THETA))
13200 &" COSTH="&CVG(COS(THETA))
13300 &"C = " &CVG(C));
13400 edges[edge_count+edge_x]←opx;
13500 edges[edge_count+edge_y]←opy;
13600 EDGES[EDGE_COUNT+EDGE_TH]←THETA;
13700 EDGES[EDGE_COUNT+EDGE_C]←C;
13800 edge_index←edge_index+1;
13900 edge_count←edge_count+edge_blsize;
14000 end "store";
14100 IF EDGE_COUNT>LIMIT THEN RETURN(Y);
14200 away:
14300 END "XSCAN";
14400 end "CLX";
14500 END "SHOW1";
14600 DIFF←DIFFSAVE;
14700 edge_count←edge_count-edge_blsize;
14800 IF DIS_EYE THEN
14900 BEGIN
15000 EDGE_DISP(0,EDGE_INDEX,X1,Y1,X2,Y2,EDGES);
15100 DPYOUT(1);
15200 IF CAL_COMP THEN CALCOMP("NEWEDG",BUF);
15300 END;
15400 LAST: RETURN(-1);
15500 END "SCAN_EDGE";
00100
00200 BOOLEAN PROCEDURE MAX_TEST(SHORT INTEGER JSAVE,MAXT;
00300 SHORT INTEGER ARRAY HIST);
00400
00500 ⊃ HERE WE TEST FOR A MAXIMUM (PEAK) ALONG THE THETA OR C-AXIS
00600 HISTOGRAM. WE REQUIRE 4 ADJACENT HISTOGRAM BUCKETS TO
00700 CONTAIN NHIGH OR MORE EDGE-POINTS;
00800
00900 BEGIN "MAX"
01000
01100 IF JSAVE-3<0∨JSAVE+3>MAXT THEN RETURN(-1)
01200 ELSE
01300 IF HIST[JSAVE-2]+HIST[JSAVE-1]+HIST[JSAVE]+HIST[JSAVE+1]>NHIGH_1
01400 ∨ HIST[JSAVE-1]+HIST[JSAVE]+HIST[JSAVE-2]+HIST[JSAVE-3]>NHIGH_1
01500 ∨ HIST[JSAVE-1]+HIST[JSAVE+2]+HIST[JSAVE]+HIST[JSAVE+1]>NHIGH_1
01600 ∨ HIST[JSAVE+3]+HIST[JSAVE+2]+HIST[JSAVE]+HIST[JSAVE+1]>NHIGH_1
01700 THEN RETURN(-1);
01800 RETURN(0);
01900 END "MAX";
02000
02100
02200
02300 BOOLEAN PROCEDURE HIST_TH;
02400
02500 ⊃ This procedure generates a histogram along the
02600 THETA axis;
02700
02800 BEGIN "HIST_TH"
02900 SHORT INTEGER I,J,JSAVE,JEND,MAX,LARGEST,LAST;
03000 SHORT REAL THETA;
03100
03200 LAST←EDGE_INDEX*EBS;
03300 FOR I←0 STEP 1 UNTIL MAXT DO HIST[I]←0;
03400 FOR I←EDGE_BLSIZE STEP EDGE_BLSIZE UNTIL LAST DO
03500 BEGIN
03600 THETA ← EDGES[I+PTH];
03700 J ← (THETA-PIO2)*THFACTOR;
03800 ⊃ IF J+1<0∨J>MAXT+1 THEN
03900 OUTSTR(CRLF&" J="&CVS(J)&" THETA="&CVG(THETA)&
04000 " THFACTOR="&CVG(THFACTOR));
04100 HIST[J] ← HIST[J] + 1;
04200 END;
04300 MAX ← LARGEST ← 0; JEND ←5;
04400 ⊃ HERE WE ARE LOOKING FOR PEAKS IN THE HISTOGRAM ALONG THE THETA-AXIS;
04500 FOR I←0 STEP 1 UNTIL MAXT DO
04600 IF HIST[I]>NMIN THEN
04700 BEGIN
04800 JSAVE←I;
04900 MAX ← HIST[I];
05000 IF I>MAXT-5 THEN JEND←MAXT-I;
05100 FOR J←1 STEP 1 UNTIL JEND DO
05200 IF HIST[I+J]>MAX THEN
05300 BEGIN MAX←HIST[I+J]; JSAVE←I+J; END;
05400 IF JSAVE<MAXT-3 THEN I←JSAVE+3 ELSE I←MAXT;
05500 IF LARGEST<MAX THEN LARGEST←MAX;
05600 IF HIST[JSAVE]>NHIGH∨MAX_TEST(JSAVE,MAXT,HIST) THEN
05700 BEGIN
05800 PEAKS[NPEAKS] ← JSAVE/THFACTOR + PIO2;
05900 IF DISP_HIST THEN OUTSTR("PEAKS = "&CVS(JSAVE)&" "&
06000 CVG(PEAKS[NPEAKS])&CRLF);
06100 NPEAKS←NPEAKS+1;
06200 END;
06300 END;
06400 IF NPEAKS=0 THEN RETURN(0);
06500 IF DISP_HIST THEN H_DISPLAY(0,1,MAXT,LARGEST,HIST);
06600 RETURN(-1);
06700 END "HIST_TH";
00100
00200 BOOLEAN PROCEDURE HISTC;
00300
00400 COMMENT THIS PROCEDURE GENERATES A HISTOGRAM ALONG THE
00500 C-AXIS FOR A GIVEN DELTA-THETA;
00600
00700 BEGIN "HISTC"
00800 SHORT INTEGER N,II,J,I,JSAVE,JEND,MAX,LARGEST,LAST,MINHP;
00900 SHORT REAL C;
01000 LABEL B1;
01100 ⊃ OUTSTR(CRLF&"NUMBER OF PEAKS = " &CVS(NPEAKS));
01200 MINHP←NHUMPS;
01300 FOR N←0 STEP 1 UNTIL NPEAKS-1 DO
01400 BEGIN
01500 LAST←EDGE_INDEX*EBS;
01600 FOR I←0 STEP 1 UNTIL MAXC DO HIST[I]←0;
01700 FOR II←EDGE_BLSIZE STEP EDGE_BLSIZE UNTIL LAST DO
01800 IF ABS(EDGES[II+PTH]-PEAKS[N])<NDTH THEN
01900 BEGIN
02000 C←EDGES[II+PC];
02100 J←(C+DXY)*CFACTOR;
02200 ⊃ IF J+1<0∨J>MAXC+1 THEN
02300 OUTSTR(CRLF&" J="&CVS(J)&" C="&CVG(C)&
02400 " CFACTOR="&CVG(CFACTOR));
02500 HIST[J]←HIST[J]+1;
02600 END;
02700 MAX ← LARGEST ← 0; JEND ←3;
02800 B1: FOR I←0 STEP 1 UNTIL MAXC DO
02900 IF HIST[I]>NMIN THEN
03000 BEGIN
03100 JSAVE←I;
03200 MAX ← HIST[I];
03300 IF I>MAXC-3 THEN JEND←MAXC-I;
03400 FOR J←1 STEP 1 UNTIL JEND DO
03500 IF HIST[I+J]>MAX THEN
03600 BEGIN MAX←HIST[I+J]; JSAVE←I+J; END;
03700 IF JSAVE<MAXC-3 THEN I←JSAVE+3 ELSE I←MAXC;
03800 IF LARGEST<MAX THEN LARGEST←MAX;
03900 IF HIST[JSAVE]>NHIGH∨MAX_TEST(JSAVE,MAXC,HIST) THEN
04000 BEGIN
04100 HUMPS[NHUMPS,2] ← JSAVE/CFACTOR -DXY;
04200 HUMPS[NHUMPS,1] ← PEAKS[N];
04300 IF DISP_HIST THEN OUTSTR("HUMPS = "&CVS(JSAVE)&" "&
04400 CVG(HUMPS[NHUMPS,2])&" "&
04500 CVG(HUMPS[NHUMPS,1])&CRLF);
04600 NHUMPS←NHUMPS+1;
04700 END;
04800 IF NHUMPS≥LINE_LIMIT THEN RETURN(-1);
04900 END;
05000 IF DISP_HIST THEN H_DISPLAY(0,1,MAXC,LARGEST,HIST);
05100 END;
05200 IF MINHP=NHUMPS THEN RETURN(0) ELSE RETURN(-1);
05300 END "HISTC";
00100
00200
00300
00400 PROCEDURE SPLIT(SHORT REAL TH_AVE,C_AVE,SINTH,COSTH;
00500 SHORT REAL ARRAY LTEMP; REFERENCE SHORT REAL SUMTH,SUMC;
00600 REFERENCE SHORT INTEGER SUMN);
00700
00800 ⊃ HERE WE SPLIT THE EDGE POINTS THAT FORM 2 LINES AND WORK WITH
00900 THE LINE THAT HAS THE MOST EDGES-POINTS BY RECENTERING TH_AVE AND C_AVE;
01000
01100 BEGIN "SPLIT"
01200 SHORT INTEGER SUM_MINUS,PT1,PT2,I;
01300 SHORT REAL SUMTHM,SUMCM,TEMP,TEMP2,RESID;
01400 SHORT REAL OPX,OPY,CX,CY;
01500 SHORT INTEGER ARRAY BUF2[1:BUF2_LIMIT];
01600 IF DISP_POINTS THEN
01700 BEGIN
01800 DPYSET(BUF2);
01900 BOUNDARY(X1,Y2,X2,Y1);
02000 PT2←DPYPARS;
02100 DPYSET(BUF);
02200 BOUNDARY(X1,Y2,X2,Y1);
02300 PT1←DPYPARS;
02400 END;
02500 SUMN←SUM_MINUS←0;
02600 SUMTH←SUMTHM←SUMC←SUMCM←0;
02700 FOR I←EDGE_BLSIZE STEP EDGE_BLSIZE UNTIL L_INDEX*EDGE_BLSIZE DO
02800 BEGIN "MGET"
02900 TEMP←ABS(LTEMP[I+PTH]-TH_AVE); TEMP2←LTEMP[I+PTH];
03000 IF ABS(TEMP-PIT2)<NDTH THEN
03100 IF (TEMP2←LTEMP[I+PTH]-PIT2)<0 THEN TEMP2←LTEMP[I+PTH]+PIT2;
03200 IF ABS(LTEMP[I+PC]-C_AVE)<NDC
03300 ∧(TEMP<NDTH∨ABS(TEMP-PIT2)<NDTH) THEN
03400 BEGIN "OUTSIDE"
03500 IF (RESID←COSTH*LTEMP[I+POPX]+SINTH*LTEMP[I+POPY]+C_AVE)≥0 THEN
03600 BEGIN
03700 SUMN←SUMN+1;
03800 SUMTH ←SUMTH+TEMP2;
03900 SUMC←SUMC+LTEMP[I+PC];
04000 IF DISP_POINTS THEN
04100 BEGIN
04200 DPYRESET(PT1);
04300 OPX←LTEMP[I+POPX];
04400 OPY←LTEMP[I+POPY];
04500 CY←SIN(TEMP2);
04600 CX←COS(TEMP2);
04700 DISP_EDGE;
04800 PT1←DPYPARS;
04900 END;
05000 END ELSE
05100 BEGIN
05200 SUM_MINUS←SUM_MINUS+1;
05300 SUMTHM ←SUMTHM+TEMP2;
05400 SUMCM←SUMCM+LTEMP[I+PC];
05500 IF DISP_POINTS THEN
05600 BEGIN
05700 DPYRESET(PT2);
05800 OPX←LTEMP[I+POPX];
05900 OPY←LTEMP[I+POPY];
06000 CY←SIN(TEMP2);
06100 CX←COS(TEMP2);
06200 DISP_EDGE;
06300 PT2←DPYPARS;
06400 END;
06500 END;
06600 ⊃ OUTSTR(CRLF&"RESID(SPLIT)= "&CVG(RESID)&" TH="&CVG(TEMP2)&" C="
06700 &CVG(LTEMP[I+PC]));
06800 ⊃ OUTSTR(CRLF&" X="&CVG(LTEMP[I+POPX])&" Y="&CVG(LTEMP[I+POPY]));
06900 END "OUTSIDE"; END "MGET";
07000 IF DISP_POINTS THEN
07100 BEGIN
07200 DPYRESET(PT1);
07300 AIVECT(-300,420);
07400 DPYSST("SPLIT: NUMBER OF POSITIVE POINTS="&CVS(SUMN));
07500 DPYOUT(1);
07600 INCHWL;
07700 INCHWL;
07800 DPYRESET(PT2);
07900 AIVECT(-300,420);
08000 DPYSST("SPLIT: NUMBER OF NEGATIVE POINTS="&CVS(SUM_MINUS));
08100 DPYOUT(1);
08200 INCHWL;
08300 INCHWL;
08400 DPYCLR;
08500 END;
08600 IF SUM_MINUS>SUMN THEN
08700 BEGIN
08800 IF SUMN>NHIGH THEN
08900 BEGIN
09000 HUMPS[NHUMPS,1]←SUMTH/SUMN;
09100 HUMPS[NHUMPS,2]←SUMC/SUMN;
09200 NHUMPS←NHUMPS+1;
09300 END;
09400 SUMN←SUM_MINUS; SUMTH←SUMTHM; SUMC←SUMCM;
09500 END
09600 ELSE
09700 IF SUM_MINUS>NHIGH THEN
09800 BEGIN
09900 HUMPS[NHUMPS,1]←SUMTHM/SUM_MINUS;
10000 HUMPS[NHUMPS,2]←SUMCM/SUM_MINUS;
10100 NHUMPS←NHUMPS+1;
10200 END;
10300 END "SPLIT";
00100
00200
00300
00400 BOOLEAN PROCEDURE LINETEST(SHORT INTEGER N; SHORT REAL TH_AVE,C_AVE,NDTH,NDC;
00500 SHORT REAL ARRAY LTEMP);
00600
00700 ⊃ Here we determine if there are a set of edge points in array
00800 LTEMP that form a line with THETA and C values near
00900 TH_AVE and C_AVE;
01000
01100 BEGIN "LINETEST"
01200 SHORT INTEGER I,J,CYC,MEAN,ISAVE,K,MIN,SUMN, SUM_PLUS,SUM_MINUS;
01300 SHORT INTEGER TEST3,SAVET,IMAX,IMIN,MAX;
01400 SHORT INTEGER MAX2,ISAVE2,LOWEST;
01500 BOOLEAN TEST, GAP1_FOUND, GAP2_FOUND;
01600 STRING PTEST;
01700 SHORT REAL TEMP,TEMP2,SUMTH,SUMC,SINTH,COSTH,RESID,THETA;
01800 SHORT REAL MG_LENGTH, GAP, DEN, RESMIN, RESMAX, DTHET, DCEE;
01900 SHORT REAL CHI,TESTXY,RES;
02000 SHORT REAL CPRIME,TH_LS,C_LS,SUMX,SUMY,SUMXY,SUMXSQ,SUMYSQ,SUM_RESID;
02100 LABEL AGAIN,AFTER,AGAIN2,AGAIN3,AGAIN4,LAST1,LAST2,POOR_LINE;
02200 LABEL AVER,TLINE,PART1,PART2,PART3,FIRSTK,LASTK, BEFORE;
02300 LABEL LAS1,LAS2;
02400 TEST3←0; RESID←0; CYC←-1;
02500 BEFORE: COSTH←COS(TH_AVE); SINTH←SIN(TH_AVE);
02600 SUM_PLUS←SUM_MINUS←0;
02700 FOR J←0 STEP 1 UNTIL 202 DO
02800 HIST[J]←0;
02900 INDEX ← INDEX -EDGE_BLSIZE; SAVET←0;
03000 L_INDEX ← INDEX DIV EDGE_BLSIZE;
03100 ⊃ HERE WE START 2 CYCLES TO SEPARATE EDGE_POINTS BY THEIR:
03200 THETA-VALUES, C-VALUES, AND RESIDUALS;
03300 AGAIN: CYC←CYC+1; SUMTH←0; SUMC←0; SUMN←0; SUMX←SUMY←SUMXY←0;
03400 SUMXSQ←SUMYSQ←0;
03500 AGAIN2: FOR I←EDGE_BLSIZE STEP EDGE_BLSIZE UNTIL L_INDEX*EDGE_BLSIZE DO
03600 BEGIN "KGET"
03700 TEMP←ABS(LTEMP[I+PTH]-TH_AVE); TEMP2←LTEMP[I+PTH];
03800 IF ABS(TEMP-PIT2)<NDTH THEN
03900 IF (TEMP2←LTEMP[I+PTH]-PIT2)<0 THEN TEMP2←LTEMP[I+PTH]+PIT2;
04000 IF ABS(LTEMP[I+PC]-C_AVE)<NDC
04100 ∧(TEMP<NDTH∨ABS(TEMP-PIT2)<NDTH) THEN
04200 BEGIN
04300 RES←COSTH*LTEMP[I+POPX]+SINTH*LTEMP[I+POPY]+C_AVE;
04400 IF CYC=0 THEN
04500 BEGIN
04600 IF RES>-10.∧RES<10. THEN
04700 BEGIN
04800 J←MAXDR*(RES+10.);
04900 HIST[J]←HIST[J]+1;
05000 END
05100 ELSE
05200 BEGIN
05300 IF RES<-10. THEN SUM_MINUS←SUM_MINUS+1
05400 ELSE SUM_PLUS←SUM_PLUS+1;
05500 END;
05600 GO TO LASTK;
05700 END;
05800 IF RES<RESMIN∨RES>RESMAX THEN GO TO AFTER;
05900 ⊃ OUTSTR(CRLF&"RESIDUAL="&CVG(RESID)&" SUMN="&CVS(SUMN));
06000 FIRSTK: SUMN←SUMN+1;
06100 SUMTH ←SUMTH+TEMP2;
06200 SUMC←SUMC+LTEMP[I+PC];
06300 SUMX←SUMX+LTEMP[I+POPX];
06400 SUMY←SUMY+LTEMP[I+POPY];
06500 SUMXY←SUMXY+LTEMP[I+POPY]*LTEMP[I+POPX];
06600 SUMXSQ←SUMXSQ+LTEMP[I+POPX]↑2;
06700 SUMYSQ←SUMYSQ+LTEMP[I+POPY]↑2;
06800 ⊃ OUTSTR(CRLF&"RESIDUAL="&CVG(RESID)&
06900 " X="&CVG(LTEMP[I+POPX])&
07000 " Y="&CVG(LTEMP[I+POPY])&
07100 " TH="&CVG(LTEMP[I+PTH])&
07200 " C="&CVG(LTEMP[I+PC]));
07300
07400 END ELSE
07500 AFTER: IF CYC>0∧¬TEST3 THEN
07600 BEGIN
07700 ⊃ NOW WE PUT THE BAD-FIT EDGE POINTS BACK IN ARRAY EDGES;
07800 EDGE_INDEX ← EDGE_INDEX +1;
07900 EI ← EDGE_INDEX*EDGE_BLSIZE;
08000 EDGES[EI+PTH] ← LTEMP[I+PTH];
08100 EDGES[EI+PC] ← LTEMP[I+PC];
08200 EDGES[EI+POPX] ← LTEMP[I+POPX];
08300 EDGES[EI+POPY] ← LTEMP[I+POPY];
08400 LTEMP[I+PTH]←LTEMP[INDEX+PTH];
08500 LTEMP[I+PC]←LTEMP[INDEX+PC];
08600 LTEMP[I+POPX]←LTEMP[INDEX+POPX];
08700 LTEMP[I+POPY]←LTEMP[INDEX+POPY];
08800 I ← I - EDGE_BLSIZE;
08900 L_INDEX ← L_INDEX -1;
09000 INDEX ← INDEX -EDGE_BLSIZE;
09100 END;
09200 LASTK: END "KGET";
09300 IF CYC=0 THEN
09400 BEGIN
09500 MAX←0;
09600 FOR J←0 STEP 1 UNTIL MAXR DO
09700 IF HIST[J]>MAX THEN BEGIN MAX←HIST[J];ISAVE←J; END
09800 ELSE IF HIST[J]=MAX THEN
09900 BEGIN MAX2←HIST[J]; ISAVE2←J; END;
10000 IF DISP_POINTS THEN H_DISPLAY(0,1,MAXR,MAX,HIST);
10100 IF MAX<RHIGH THEN GO TO POOR_LINE;
10200 IF ¬TEST3∧(ISAVE<MINRES∨ISAVE>MAXRES) THEN
10300 TEST3←-1 ELSE TEST3←0;
10400
10500 PART1: FOR J←ISAVE STEP 1 UNTIL MAXR DO
10600 IF HIST[J]>0 THEN IMAX←J
10700 ELSE IF HIST[J+1]=0∧HIST[J+2]=0∧HIST[J+3]=0 THEN
10800 GO TO PART2;
10900 PART2: FOR J←ISAVE STEP -1 UNTIL 0 DO
11000 IF HIST[J]>0 THEN IMIN←J
11100 ELSE IF HIST[J-1]=0∧HIST[J-2]=0∧HIST[J-3]=0 THEN
11200 GO TO PART3;
11300 PART3: RESMIN←(IMIN-1)/MAXDR -10.;
11400 RESMAX←(IMAX+1)/MAXDR -10.;
11500 IF DISP_POINTS THEN
11600 BEGIN
11700 DPYCLR;
11800 DPYSET(BUF);
11900 AIVECT(-300,420);
12000 DPYSST("CYCLE=0 BEFORE OMITTING BAD POINTS");
12100 INIT_DOMAIN(X1,Y2,X2,Y1);
12200 BOUNDARY(X1,Y2,X2,Y1);
12300 EDGE_DISP(0,L_INDEX,X1,Y1,X2,Y2,LTEMP);
12400 DPYOUT(1);
12500 INCHWL;
12600 INCHWL;
12700 DPYCLR;
12800 END;
12900 SUMN←0;
13000 FOR J←IMIN STEP 1 UNTIL IMAX DO
13100 SUMN← SUMN+HIST[J];
13200 IF SUMN≤NHIGH∧¬TEST3 THEN
13300 BEGIN
13400 IF MAX2<2 THEN GO TO POOR_LINE;
13500 MAX2←0; ISAVE←ISAVE2;
13600 GO TO PART1;
13700 END;
13800 GO TO AGAIN;
13900
14000 END;
14100 ⊃ THIS IS USED WHEN THERE ARE TOO FEW GOOD EDGE POINTS;
14200 IF RESMAX<-900. THEN RETURN(0);
14300 AVER: IF SUMN≤NHIGH∧¬TEST3 THEN GO TO POOR_LINE;
14400 TH_AVE←SUMTH/SUMN; C_AVE←SUMC/SUMN;
14500 IF TEST3 THEN BEGIN CYC←-1; GO TO BEFORE; END;
14600 IF ABS(SIN(TH_AVE))>0.5 THEN
14700 BEGIN "CASE_A"
14800 CPRIME←(SUMX*SUMXY-SUMY*SUMXSQ)/(SUMN*SUMXSQ-SUMX*SUMX);
14900 THETA←ATAN(-SUMXSQ/(CPRIME*SUMX+SUMXY));
15000 ⊃ OUTSTR(CRLF&"THETA="&CVG(THETA));
15100 J←1.2*(TH_AVE-THETA)/PI1+.1;
15200 TH_LS←THETA+J*PI1;
15300 IF ABS(TH_AVE-TH_LS)>NDTH2 THEN
15400 BEGIN TH_LS←TH_AVE; CPRIME←C_AVE/SIN(TH_AVE); END;
15500 SINTH←SIN(TH_LS); COSTH←COS(TH_LS);
15600 C_LS←CPRIME*SINTH;
15700 GO TO LAST1;
15800 END "CASE_A"
15900
16000 ELSE
16100 BEGIN "CASE_B"
16200 CPRIME←(SUMY*SUMXY-SUMX*SUMYSQ)/(SUMN*SUMYSQ-SUMY*SUMY);
16300 THETA←ATAN(-(CPRIME*SUMY+SUMXY)/SUMYSQ);
16400 ⊃ OUTSTR(CRLF&"THETA="&CVG(THETA));
16500 J←1.2*(TH_AVE-THETA)/PI1+.1;
16600 TH_LS←THETA+J*PI1;
16700 IF ABS(TH_AVE-TH_LS)>NDTH2 THEN
16800 BEGIN TH_LS←TH_AVE; CPRIME←C_AVE/COS(TH_AVE); END;
16900 SINTH←SIN(TH_LS); COSTH←COS(TH_LS);
17000 C_LS←CPRIME*COSTH;
17100 END "CASE_B";
17200
17300 LAST1: SUM_RESID←0;
17400 FOR I←EBS STEP EBS UNTIL L_INDEX*EBS DO
17500 BEGIN
17600 RESID←(COSTH*LTEMP[I+POPX]+SINTH*LTEMP[I+POPY]+C_LS)↑2;
17700 SUM_RESID←SUM_RESID+RESID;
17800 END;
17900 CHI←SQRT(SUM_RESID/(SUMN-2));
18000 ⊃ OUTSTR(CRLF&"TH_AVE="&CVG(TH_AVE)
18100 &" TH_LS="&CVG(TH_LS)
18200 &" C_LS="&CVG(C_LS)
18300 &" C_AVE="&CVG(C_AVE)
18400 &" CHI="&CVG(CHI));
18500 IF CHI>NDCHI THEN GO TO POOR_LINE ELSE GO TO TLINE;
18600 POOR_LINE:
18700 ⊃ SINCE THINGS ARE NOT WORKING OUT, WE TRY SPLITTING THE EDGE_POINTS
18800 IN ORDER TO TAKE CARE OF CASE WHEN 2 LINES GIVE US A POOR TH_AVE
18900 AND C_AVE;
19000 IF CYC=0∧(SUM_MINUS>NHIGH∨SUM_PLUS>NHIGH) THEN
19100 BEGIN
19200 IF DISP_POINTS THEN
19300 BEGIN
19400 DPYCLR;
19500 DPYSET(BUF);
19600 AIVECT(-300,420);
19700 DPYSST("BEFORE SPLIT");
19800 INIT_DOMAIN(X1,Y2,X2,Y1);
19900 BOUNDARY(X1,Y2,X2,Y1);
20000 EDGE_DISP(0,L_INDEX,X1,Y1,X2,Y2,LTEMP);
20100 DPYOUT(1);
20200 INCHWL;
20300 INCHWL;
20400 DPYCLR;
20500 END;
20600 CYC←-1;
20700 SPLIT(TH_AVE,C_AVE,SINTH,COSTH,LTEMP,SUMTH,SUMC,SUMN);
20800 ⊃ OUTSTR(CRLF&" IN SPLIT ");
20900 TH_AVE←SUMTH/SUMN; C_AVE←SUMC/SUMN;
21000 GO TO BEFORE;
21100 END
21200 ELSE
21300 BEGIN
21400 IF DISP_POINTS THEN BEGIN "QUESTION" OUTSTR(CRLF&"THIS IS A POOR FIT --
21500 ONLY "&CVS(SUMN)&" GOOD POINTS. CHI = "&CVG(CHI)&"
21600 DO YOU WANT TO SEE THE EDGES -- Y OR N?");
21700 PTEST ← INCHWL;
21800 IF EQU(PTEST,"Y") THEN
21900 BEGIN
22000 DPYCLR;
22100 DPYSET(BUF);
22200 INIT_DOMAIN(X1,Y2,X2,Y1);
22300 BOUNDARY(X1,Y2,X2,Y1);
22400 EDGE_DISP(0,L_INDEX,X1,Y1,X2,Y2,LTEMP);
22500 DPYOUT(1);
22600 INCHWL;
22700 INCHWL;
22800 DPYCLR;
22900 END; END "QUESTION";
23000 ⊃ WE ARE GOING TO GET RID OF THIS LINE;
23100 RESMAX←-1000; CYC←1;
23200 HUMPS[N,2]←HUMPS[NHUMPS-1,2];
23300 HUMPS[N,1]←HUMPS[NHUMPS-1,1];
23400 NHUMPS←NHUMPS-1;
23500 GO TO AGAIN2;
23600 END;
23700 TLINE: IF ¬DISP_POINTS THEN GO TO LAST2;
23800 DPYCLR;
23900 DPYSET(BUF);
24000 AIVECT(-300,420);
24100 DPYSST("CHI="&CVG(CHI)&" NO. OF POINTS="&CVG(SUMN));
24200 EDGE_DISP(0,L_INDEX,X1,Y1,X2,Y2,LTEMP);
24300 DPYOUT(1);
24400 INCHWL;
24500 INCHWL;
24600 LAST2: DEN←ABS(SINTH); GAP1_FOUND←0;
24700 IF DEN>0.5 THEN TESTXY←POPX
24800 ELSE BEGIN TESTXY←POPY; DEN←ABS(COSTH); END;
24900 LOWEST← EBS;
25000 AGAIN3: MIN←1000;
25100 FOR I←LOWEST STEP EBS UNTIL INDEX DO
25200 IF LTEMP[I+TESTXY]<MIN THEN
25300 BEGIN ISAVE←I; MIN←LTEMP[I+TESTXY]; END;
25400 IF ISAVE≠LOWEST THEN
25500 FOR J←POPX STEP 1 UNTIL POPX+EBS-1 DO
25600 BEGIN
25700 TEMP←LTEMP[ISAVE+J];
25800 LTEMP[ISAVE+J]←LTEMP[LOWEST+J];
25900 LTEMP[LOWEST+J]←TEMP;
26000 END;
26100 LOWEST←LOWEST+EBS;
26200 IF LOWEST≠INDEX THEN GO TO AGAIN3;
26300 AGAIN4: GAP2_FOUND←0; MEAN←(L_INDEX DIV 2)*EBS;
26400 MG_LENGTH←NDGAP*(LTEMP[INDEX+TESTXY]-LTEMP[EBS+TESTXY])/DEN;
26500 ⊃ OUTSTR(CRLF&"INDEX="&CVS(INDEX)
26600 &" MEAN="&CVS(MEAN)
26700 &" MG_LENGTH="&CVS(MG_LENGTH));
26800 ⊃ OUTSTR(CRLF&" X="&CVG(LTEMP[EBS+POPX])&" Y="&CVG(LTEMP[EBS+POPY]));
26900 ⊃ OUTSTR(CRLF&" X="&CVG(LTEMP[INDEX+POPX])&" Y="&CVG(LTEMP[INDEX+POPY]));
27000 F_INDEX←INDEX;
27100 IF (LTEMP[TESTXY+2*EBS]-LTEMP[TESTXY+EBS])/DEN>NDS THEN
27200 LTEMP[TESTXY+EBS]←-100;
27300 IF (LTEMP[TESTXY+F_INDEX]-LTEMP[TESTXY+F_INDEX-EBS])/DEN>NDS THEN
27400 LTEMP[TESTXY+F_INDEX]←2000;
27500 FOR J←EBS STEP EBS UNTIL F_INDEX-EBS DO
27600 BEGIN
27700 GAP←(LTEMP[J+TESTXY+EBS]-LTEMP[J+TESTXY])/DEN;
27800 IF GAP>NDS3∨GAP>MG_LENGTH THEN
27900 BEGIN "ELIMINATE"
28000 GAP1_FOUND←GAP2_FOUND←-1;
28100 IF DISP_POINTS THEN OUTSTR(CRLF&"GAP FOUND N="&CVS(N)
28200 &" GAP="&CVG(GAP)&" MG_LENGTH="&CVG(MG_LENGTH));
28300 IF J<MEAN THEN
28400 BEGIN "FIRST"
28500 FOR I←EBS STEP EBS UNTIL J DO
28600 BEGIN
28700 ⊃ NOW WE PUT THE BAD-FIT EDGE POINTS BACK IN ARRAY EDGES;
28800 EDGE_INDEX ← EDGE_INDEX +1;
28900 EI ← EDGE_INDEX*EDGE_BLSIZE;
29000 EDGES[EI+PTH] ← LTEMP[I+PTH];
29100 EDGES[EI+PC] ← LTEMP[I+PC];
29200 EDGES[EI+POPX] ← LTEMP[I+POPX];
29300 EDGES[EI+POPY] ← LTEMP[I+POPY];
29400 L_INDEX ← L_INDEX -1;
29500 INDEX ← INDEX -EDGE_BLSIZE;
29600 END;
29700 K←0;
29800 FOR I←J+EBS STEP EBS UNTIL F_INDEX DO
29900 BEGIN
30000 K←K+EBS;
30100 LTEMP[K+PTH]←LTEMP[I+PTH];
30200 LTEMP[K+PC]←LTEMP[I+PC];
30300 LTEMP[K+POPX]←LTEMP[I+POPX];
30400 LTEMP[K+POPY]←LTEMP[I+POPY];
30500 END;
30600 END "FIRST"
30700 ELSE
30800 FOR I←J+EBS STEP EBS UNTIL F_INDEX DO
30900 BEGIN
31000 ⊃ NOW WE PUT THE BAD-FIT EDGE POINTS BACK IN ARRAY EDGES;
31100 EDGE_INDEX ← EDGE_INDEX +1;
31200 EI ← EDGE_INDEX*EDGE_BLSIZE;
31300 EDGES[EI+PTH] ← LTEMP[I+PTH];
31400 EDGES[EI+PC] ← LTEMP[I+PC];
31500 EDGES[EI+POPX] ← LTEMP[I+POPX];
31600 EDGES[EI+POPY] ← LTEMP[I+POPY];
31700 L_INDEX ← L_INDEX -1;
31800 INDEX ← INDEX -EDGE_BLSIZE;
31900 END;
32000 IF L_INDEX ≤ NHIGH THEN GO TO POOR_LINE;
32100 GO TO AGAIN4;
32200 END "ELIMINATE";
32300 END;
32400 IF L_INDEX≤NHIGH THEN GO TO POOR_LINE;
32500 IF GAP1_FOUND THEN BEGIN CYC←-1; GO TO BEFORE; END;
32600 ⊃ OUTSTR(CRLF&" NO GAPS FOUND THIS CYCLE");
32700 FOR I←EBS STEP EBS UNTIL INDEX DO
32800 BEGIN
32900 ⊃ NOW WE STORE THE GOOD-FIT EDGE POINTS IN ARRAY LINES;
33000 LINEPTS(LINE_INDEX+POPX) ← LTEMP[I+POPX];
33100 LINEPTS(LINE_INDEX+POPY) ← LTEMP[I+POPY];
33200 LINEPTS(LINE_INDEX+PC) ← LTEMP[I+PC];
33300 LINEPTS(LINE_INDEX+PTH) ← LTEMP[I+PTH];
33400 LINE_INDEX ← LINE_INDEX + EDGE_BLSIZE;
33500 END;
33600 ⊃ FILLING ARRAY HUMPS;
33700 HUMPS[N,THET] ← TH_LS;
33800 HUMPS[N,CEE] ← C_LS;
33900 HUMPS[N,4] ← LINE_INDEX-EBS;
34000 HUMPS[N,CHIVALUE] ← CHI;
34100 HUMPS[N,8]←SUMN;
34200 HUMPS[N,SINTHETA]←SINTH;
34300 HUMPS[N,COSTHETA]←COSTH;
34400 RETURN(-1);
34500 END "LINETEST";
34600
00100
00200
00300 BOOLEAN PROCEDURE LINER;
00400
00500 ⊃ HERE THE EDGE-POINTS ARE SEPARATED INTO A GROUP FOR EACH LINE;
00600
00700 BEGIN "LINER"
00800 SHORT INTEGER N,I;
00900 SHORT REAL TH_AVE,C_AVE,TEMP;
01000 LABEL BEF1,LAST;
01100 SHORT REAL ARRAY LTEMP[1:LT_LIMIT];
01200
01300 IF NHUMPS=MINHUMPS THEN RETURN(0);
01400 FOR N←MINHUMPS STEP 1 UNTIL NHUMPS-1 DO
01500 BEGIN
01600 ⊃ FILLING ARRAY HUMPS; HUMPS[N,3]←LINE_INDEX;
01700 INDEX ← EDGE_BLSIZE;
01800 ⊃ HERE WE TAKE ALL EDGE_POINTS INSIDE A LARGE REGION (4NDTH*4NDC)
01900 AND STORE THEM IN ARRAY LTEMP;
02000 FOR I←EDGE_BLSIZE STEP EDGE_BLSIZE UNTIL EDGE_INDEX*EDGE_BLSIZE DO
02100 BEGIN "LGET"
02200 TEMP←ABS(EDGES[I+PTH]-HUMPS[N,1]);
02300 IF ABS(EDGES[I+PC]-HUMPS[N,2])<NDC2
02400 ∧(TEMP<NDTH2∨ABS(TEMP-PIT2)<NDTH2) THEN
02500 BEGIN
02600 LTEMP[INDEX+PTH] ← EDGES[I+PTH];
02700 LTEMP[INDEX+PC] ← EDGES[I+PC];
02800 LTEMP[INDEX+POPX] ← EDGES[I+POPX];
02900 LTEMP[INDEX+POPY] ← EDGES[I+POPY];
03000 EI ← EDGE_INDEX*EDGE_BLSIZE;
03100 EDGES[I+POPX] ← EDGES[EI+POPX];
03200 EDGES[I+POPY] ← EDGES[EI+POPY];
03300 EDGES[I+PC] ← EDGES[EI+PC];
03400 EDGES[I+PTH] ← EDGES[EI+PTH];
03500 EDGE_INDEX ← EDGE_INDEX -1;
03600 INDEX ← INDEX + EDGE_BLSIZE;
03700 I ← I - EDGE_BLSIZE;
03800 END;
03900 IF INDEX≥LT_LIMIT THEN GO TO BEF1;
04000 END "LGET";
04100 BEF1: TH_AVE←HUMPS[N,1]; C_AVE←HUMPS[N,2];
04200 IF ¬LINETEST(N,TH_AVE,C_AVE,NDTH,NDC,LTEMP) THEN
04300 BEGIN
04400 N←N-1;
04500 GO TO LAST;
04600 END;
04700 IF FLAG≠0 THEN GO TO LAST;
04800 IF ¬DISP_POINTS THEN GO TO LAST;
04900 DPYSET(BUF);
05000 LINE_FIND(EDGE_INDEX,EDGES);
05100 POINTER(TH_AVE,NDTH,C_AVE,NDC);
05200 LINE_FIND(L_INDEX,LTEMP);
05300 AIVECT(-300,420);
05400 DPYSST("TH_AVE="&CVG(TH_AVE)&" C_AVE="&CVG(C_AVE));
05500 DPYOUT(1);
05600 INCHWL;
05700 INCHWL;
05800 DPYCLR;
05900 DPYSET(BUF);
06000 AIVECT(-300,420);
06100 DPYSST("CHI="&CVG(HUMPS[N,7])&" NO. OF POINTS="&CVS(HUMPS[N,8]));
06200 INIT_DOMAIN(X1,Y2,X2,Y1);
06300 BOUNDARY(X1,Y2,X2,Y1);
06400 EDGE_DISP(0,L_INDEX,X1,Y1,X2,Y2,LTEMP);
06500 DPYOUT(1);
06600 INCHWL;
06700 LEDGE_INDEX ← LINE_INDEX DIV EDGE_BLSIZE;
06800 INIT_DOMAIN(X1,Y2,X2,Y1);
06900 BOUNDARY(X1,Y2,X2,Y1);
07000 EDGE_DISP(-1,LEDGE_INDEX,X1,Y1,X2,Y2,EDGES);
07100 ⊃ THIS WILL RESULT IN A DISPLAY OF THE LINE EDGE_POINTS;
07200 DPYOUT(1);
07300 INCHWL;
07400 INCHWL;
07500 DPYCLR;
07600 LAST:
07700 END;
07800 IF NHUMPS=MINHUMPS THEN RETURN(0);
07900 MINHUMPS ← NHUMPS;
08000 RETURN(-1);
08100 END "LINER";
08200
08300
00100
00200
00300 PROCEDURE CONNECT(INTEGER N);
00400 BEGIN "CONNECT"
00500 SHORT INTEGER I,J,INDEX1,INDEX2, ISAVE,TESTXY,JHUMP;
00600 SHORT INTEGER TEMP,LOWEST;
00700 SHORT REAL THETA, C,SINTH,COSTH,MIN,DEN,GAP;
00800 BOOLEAN SOLID;
00900 LABEL AGAIN, NEXT,OMIT;
01000 THETA←HUMPS[N,1];
01100 C←HUMPS[N,2];
01200 INDEX1←HUMPS[N,3]; ⊃ STARTING LOCATION OF EDGES IN ARRAY LINES;
01300 INDEX2←HUMPS[N,4]; ⊃ ENDING LOCATION OF EDGES IN ARRAY LINES;
01400 HUMPS[N,3]←-1;
01500 HUMPS[N,4]←-1;
01600 HUMPS[N,13]←HUMPS[N,14]←-1;
01700 HUMPS[N,15]←HUMPS[N,16]←-1;
01800 SINTH←SIN(THETA); COSTH←COS(THETA);
01900 DEN←ABS(SINTH);
02000 IF DEN>0.5 THEN TESTXY←POPX
02100 ELSE BEGIN TESTXY←POPY; DEN←ABS(COSTH); END;
02200 SOLID←-1; JHUMP←FPOINT+3;
02300 FOR I←INDEX1 STEP EBS UNTIL INDEX2 DO
02400 BEGIN
02500 GAP←(LINEPTS(I+TESTXY+EBS)-LINEPTS(I+TESTXY))/DEN;
02600 IF GAP<NDS THEN
02700 BEGIN
02800 HUMPS[N,FPOINT+1]← LINEPTS(I+POPX);
02900 HUMPS[N,FPOINT+2]← LINEPTS(I+POPY);
03000 LOWEST←I+EBS;
03100 GO TO NEXT;
03200 END;
03300 END;
03400 NEXT: IF I≥ INDEX2-2*EBS THEN GO TO OMIT;
03500 ISAVE←1;
03600 FOR I←LOWEST STEP EBS UNTIL INDEX2 DO
03700 BEGIN
03800 GAP←(LINEPTS(I+TESTXY+EBS)-LINEPTS(I+TESTXY))/DEN;
03900 IF (SOLID∧GAP<NDS32)∨(¬SOLID∧GAP>NDS32) THEN CONTINUE;
04000 HUMPS[N,JHUMP]← SOLID;
04100 HUMPS[N,JHUMP+1]← LINEPTS(I+POPX);
04200 HUMPS[N,JHUMP+2]← LINEPTS(I+POPY);
04300 JHUMP←JHUMP+3;
04400 SOLID←¬SOLID;
04500 ISAVE←ISAVE+1;
04600 END;
04700 ⊃ TO END THE LINE WE DO THE FOLLOWING;
04800 IF SOLID THEN
04900 BEGIN
05000 HUMPS[N,JHUMP]← SOLID;
05100 HUMPS[N,JHUMP+1]← LINEPTS(INDEX2+POPX);
05200 HUMPS[N,JHUMP+2]← LINEPTS(INDEX2+POPY);
05300 ISAVE←ISAVE+1;
05400 END;
05500 ⊃ IF NOT SOLID THEN WE SHALL LEAVE THE END AS THE LAST SOLID POINT;
05600 ⊃ FILLING ARRAY HUMPS;
05700 HUMPS[N,5]←ISAVE; ⊃ THIS IS THE NUMBER OF POINTS
05800 ALONG THE LINE;
05900 HUMPS[N,6]←FPOINT+3*(ISAVE-1); ⊃ THIS IS LOCATION JUST
06000 BEFORE X-LOCATION OF LAST POINT;
06100 HUMPS[N,SIGNX]←SIGN(HUMPS[N,HUMPS[N,6]+1]-HUMPS[N,FPOINT+1]);
06200 HUMPS[N,SIGNY]←SIGN(HUMPS[N,HUMPS[N,6]+2]-HUMPS[N,FPOINT+2]);
06300 ⊃ THESE ARE +1 OR -1 DEPENDING UPON WHETHER X OR Y
06400 IS INCREASING OR DECREASING;
06500 ⊃ FOR I←INDEX1 STEP EBS UNTIL INDEX2 DO
06600 OUTSTR(CRLF&" X="&CVG(LINEPTS(I+POPX))
06700 &" Y="&CVG(LINEPTS(I+POPY)));
06800 JHUMP←JHUMP+3;
06900 ⊃ FOR I←1 STEP 1 UNTIL JHUMP DO
07000 OUTSTR(CRLF&" HUMPS -- I="&CVS(I)&" "&CVG(HUMPS[N,I]));
07100 IF ¬DISP_POINTS THEN GO TO OMIT;
07200 DPYSET(BUF);
07300 BOUNDARY(X1,Y2,X2,Y1);
07400 LINE_DISP(N);
07500 DPYOUT(1);
07600 INCHWL;
07700 INCHWL;
07800 OMIT:
07900 END "CONNECT";
08000
08100
08200
00100
00200
00300
00400 PROCEDURE FORM_ONE_LINE(INTEGER N,J);
00500 BEGIN "FORM"
00600 SHORT INTEGER F,L,I,JHUMP,ISAVE,LASTPT;
00700 SHORT REAL D1,D2,ABSINTH;
00800 BOOLEAN TEST2,SOLID;
00900 LABEL FORM0,FORM2,FIRSTN,FIRSTJ,NEXT,ORD;
01000 ⊃ OUTSTR(CRLF&" IN FORM ");
01100 TEST2←0;
01200 IF N=J THEN
01300 BEGIN
01400 OUTSTR(CRLF&" SAME LINE N="&CVS(N)&" J="&CVS(J));
01500 RETURN;
01600 END;
01700 ⊃ WE COMPARE THE FIRST END OF LINE N WITH THE FIRST
01800 END OF THE LINE J;
01900 IF HUMPS[N,13]>0 THEN GO TO FIRSTN;
02000 IF HUMPS[J,13]>0 THEN GO TO FIRSTJ;
02100 ABSINTH←ABS(HUMPS[N,SINTHETA]);
02200 IF ABSINTH>0.5 THEN
02300 BEGIN
02400 D1←HUMPS[J,FPOINT+1];
02500 D2←HUMPS[N,FPOINT+1];
02600 END ELSE
02700 BEGIN
02800 D1←HUMPS[J,FPOINT+2];
02900 D2←HUMPS[N,FPOINT+2];
03000 END;
03100 ⊃ OUTSTR(CRLF&" D1="&CVG(D1)&" D2="&CVG(D2));
03200 IF D1<D2 THEN GO TO FIRSTJ;
03300 FIRSTN: BEGIN
03400 F←N; L←J;
03500 GO TO NEXT;
03600 END;
03700 FIRSTJ: BEGIN
03800 F←J; L←N;
03900 END;
04000 NEXT:
04100 IF DISP_VERT THEN OUTSTR(CRLF&" FIRST LINE="&CVS(F)
04200 &" SECOND LINE="&CVS(L));
04300 ⊃ FOR I←1 STEP 1 UNTIL HUMPS[F,6]+4 DO
04400 OUTSTR(CRLF&" I="&CVS(I)&" HUMPS[F,I]="&CVG(HUMPS[F,I]));
04500 ⊃ FOR I←1 STEP 1 UNTIL HUMPS[L,6]+4 DO
04600 OUTSTR(CRLF&" I="&CVS(I)&" HUMPS[L,I]="&CVG(HUMPS[L,I]));
04700 IF HUMPS[L,15]>0 THEN
04800 BEGIN
04900 HUMPS[F,15]←HUMPS[L,15];
05000 HUMPS[F,16]←HUMPS[L,16];
05100 HUMPS[F,4]←HUMPS[L,4];
05200 END;
05300 IF HUMPS[L,7]/(HUMPS[L,8]-3)<HUMPS[F,7]/(HUMPS[F,8]-3) THEN
05400 BEGIN
05500 HUMPS[F,1]←HUMPS[L,1];
05600 HUMPS[F,2]←HUMPS[L,2];
05700 HUMPS[F,7]←HUMPS[L,7];
05800 HUMPS[F,9]←HUMPS[L,9];
05900 HUMPS[F,10]←HUMPS[L,10];
06000 END;
06100 HUMPS[F,8]←HUMPS[F,8]+HUMPS[L,8];
06200 SOLID←-1;
06300 JHUMP←HUMPS[F,6]+3;
06400 IF JHUMP+HUMPS[L,6]-FPOINT+2≥HUMP_LIMIT THEN
06500 BEGIN
06600 FOR I←1,2 DO
06700 HUMPS[F,HUMPS[F,6]+I]←HUMPS[L,HUMPS[L,6]+I];
06800 GO TO ORD;
06900 END;
07000 HUMPS[F,5]←HUMPS[F,5]+HUMPS[L,5];
07100 HUMPS[F,JHUMP]←SOLID;
07200 JHUMP←JHUMP-FPOINT;
07300 LASTPT←HUMPS[L,6]+2;
07400 HUMPS[F,6]←JHUMP+LASTPT-2;
07500 ⊃ OUTSTR(CRLF&"JHUMP="&CVS(JHUMP)&" LASTPT="&CVS(LASTPT));
07600 ⊃ OUTSTR(CRLF&"LAST X OF L="&CVG(HUMPS[L,HUMPS[L,6]+1]));
07700 FOR I←FPOINT+1 STEP 1 UNTIL LASTPT DO
07800 HUMPS[F,I+JHUMP]←HUMPS[L,I];
07900 ⊃ OUTSTR(CRLF&"LAST X OF F="&CVG(HUMPS[F,HUMPS[F,6]+1]));
08000 ORD: ORDER(F);
08100 ⊃ FOR I←1 STEP 1 UNTIL HUMPS[F,6]+4 DO
08200 OUTSTR(CRLF&" I="&CVS(I)&" HUMPS[F,I]="&CVG(HUMPS[F,I]));
08300 FORM0: FOR J←1 STEP 1 UNTIL NVERT DO
08400 FOR I←4 STEP 1 UNTIL VERTEX[J,3]+4 DO
08500 IF VERTEX[J,I]=L THEN VERTEX[J,I]←F;
08600 FORM2: IF TEST2 THEN RETURN;
08700 JHUMP←HUMPS[NHUMPS-1,6]+2;
08800 FOR I←1 STEP 1 UNTIL JHUMP DO
08900 HUMPS[L,I]←HUMPS[NHUMPS-1,I];
09000 NHUMPS←NHUMPS-1;
09100 F←L; L←NHUMPS; TEST2←-1;
09200 ⊃ OUTSTR(CRLF&" TEST = TRUE ");
09300 GO TO FORM0;
09400 END "FORM";
09500
00100
00200
00300 BOOLEAN PROCEDURE TEST_ONE_LINE(SHORT INTEGER N,J;
00400 REFERENCE REAL X,Y);
00500 BEGIN "TES"
00600
00700 DEFINE LENGSQ="25."; ⊃ LINES OF LENGTH ≤ SQRT(LENGSQ) ARE CONSIDERED TO
00800 BE SHORT LINES AND THEREFORE ARE GIVEN GREATER
00900 ANGULAR TOLERANCE IN JOINING WITH OTHER LINES;
01000 DEFINE LONGSQ={100.}; ⊃ Lines of length longer than 10 are not joined;
01100
01200 SHORT REAL DIFF,LENGNSQ,LENGJSQ;
01300 LABEL INT;
01400
01500 LENGNSQ←LENGTHSQ(N);
01600 LENGJSQ←LENGTHSQ(J);
01700 IF LENGNSQ>LONGSQ∧LENGJSQ>LONGSQ THEN GO TO INT;
01800 IF (DIFF←ABS(HUMPS[J,THET]-HUMPS[N,THET]))<NDANG∨ABS(DIFF-PIT2)<NDANG
01900 ∨((LENGNSQ<LENGSQ∨LENGJSQ<LENGSQ)
02000 ∧(DIFF<2*NDANG∨ABS(DIFF-PIT2)<2*NDANG)) THEN
02100 BEGIN
02200 FORM_ONE_LINE(N,J);
02300 RETURN (-1);
02400 END;
02500 INT: INTERSECT(N,J);
02600 RETURN(0);
02700
02800 ⊃ OUTSTR(CRLF&" X="&CVG(X)&" Y="&CVG(Y)&" XC="&CVG(XC)&" YC="&CVG(YC));
02900 END "TES";
03000
03100
00100
00200
00300
00400
00500
00600 BOOLEAN PROCEDURE EXT_ONE(SHORT INTEGER N;BOOLEAN WHICHEND);
00700
00800 ⊃ Here we extend one end of one line;
00900
01000 BEGIN "EXT_ONE"
01100 SHORT INTEGER I,J,K,J1,J2,NUM_VERT,XEND,YEND,WHICH_END,VER_END;
01200 SHORT INTEGER XLOC,YLOC,VEND,SIGX,SIGY,VSAVE;
01300 SHORT REAL DBOUND,XC,YC,DVERT,DENDS,DENDS1,DENDS2,X,Y,LSQ;
01400 SHORT REAL D1,D2,XNJ1,YNJ1,DX,DY,VERT_GAP;
01500 SHORT REAL ARRAY ENDSAVE[1:10,1:4];
01600 LABEL LOOK1,LOOK2,LOOK3,LOOK4,LAST,AFT1,AFT2;
01700 LABEL LOOK5,LOOK6,FIRST,SECOND,PRIN,VERY_END,CONECT;
01800
01900 IF WHICHEND THEN
02000 BEGIN
02100 XLOC←FPOINT+1;
02200 YLOC←FPOINT+2;
02300 VEND←3;
02400 XEND←13;
02500 YEND←14;
02600 SIGX←-HUMPS[N,SIGNX];
02700 SIGY←-HUMPS[N,SIGNY];
02800 END ELSE
02900 BEGIN
03000 XLOC←HUMPS[N,6]+1;
03100 YLOC←HUMPS[N,6]+2;
03200 XEND←15;
03300 YEND←16;
03400 VEND←4;
03500 SIGX←HUMPS[N,SIGNX];
03600 SIGY←HUMPS[N,SIGNY];
03700 END;
03800 HUMPS[N,DIRSIN]←SIGX*ABS(HUMPS[N,SINTHETA]);
03900 HUMPS[N,DIRCOS]←SIGY*ABS(HUMPS[N,COSTHETA]);
04000 LOOK1: NUM_VERT←0;
04100 XC←HUMPS[N,XLOC]+0.95*NDRAD*HUMPS[N,DIRSIN];
04200 YC←HUMPS[N,YLOC]+0.95*NDRAD*HUMPS[N,DIRCOS];
04300
04400 ⊃ OUTSTR(CRLF&" NOW WORKING ON LINE "&CVS(N));
04500
04600
04700 IF NVERT=0 THEN GO TO LOOK2;
04800 FOR J←1 STEP 1 UNTIL NVERT DO
04900 IF (DVERT←(VERTEX[J,1]-XC)↑2+(VERTEX[J,2]-YC)↑2)
05000 <NDRSQ THEN
05100 BEGIN
05200 NUM_VERT←NUM_VERT+1;
05300 VSAVE←J;
05400 END;
05500 LOOK2: ⊃ OUTSTR(CRLF&" NUMBER OF VERTICES = "&CVS(NUM_VERT));
05600 I←0;
05700 FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
05800 ⊃ HERE WE FIND THE NUMBER OF UNENDED LINES INSIDE THE CIRCLE AND
05900 SET IT TO "I";
06000 BEGIN
06100 IF J=N THEN CONTINUE;
06200 IF HUMPS[J,13]>0 THEN DENDS1←1000 ELSE
06300 DENDS1←(HUMPS[J,FPOINT+1]-XC)↑2
06400 +(HUMPS[J,FPOINT+2]-YC)↑2;
06500 IF HUMPS[J,15]>0 THEN DENDS2←1000 ELSE
06600 DENDS2←(HUMPS[J,HUMPS[J,6]+1]-XC)↑2
06700 +(HUMPS[J,HUMPS[J,6]+2]-YC)↑2;
06800 DENDS←SMALLER(DENDS1,DENDS2);
06900 IF DENDS<NDRSQ THEN
07000 BEGIN
07100 I←I+1;
07200 ENDSAVE[I,1]←J; ⊃ LINE NUMBER;
07300 ENDSAVE[I,2]←DENDS;
07400 IF DENDS1<DENDS2 THEN BEGIN ENDSAVE[I,3]←13;
07500 ENDSAVE[I,4]←3; END
07600 ELSE BEGIN ENDSAVE[I,3]←15; ENDSAVE[I,4]←4; END;
07700 END;
07800 ⊃ ENDSAVE[I,3] STORES THE XEND NUMBER;
07900 ⊃ ENDSAVE[I,4] STORES THE VEND NUMBER;
08000 END;
08100 IF DISP_VERT THEN OUTSTR(CRLF&" NUMBER OF LINES = "&CVS(I)
08200 &", VERTICES="&CVS(NUM_VERT));
08300 IF NUM_VERT=0∧I=0 THEN GO TO LOOK5
08400 ELSE IF DIS_EYE THEN SHOWCIR(XC,YC,NDRAD);
08500 IF NUM_VERT=0∧I=1 THEN
08600 ⊃ THIS IS THE CASE OF TWO LINES INTERSECTING;
08700 LOOK3: BEGIN
08800 ⊃ OUTSTR(CRLF" IN LOOK3 ");
08900 J←ENDSAVE[1,1]; DENDS←ENDSAVE[1,2];
09000 WHICH_END←ENDSAVE[1,3]; VER_END←ENDSAVE[1,4];
09100 DX←HUMPS[J,SIGNX]*ABS(HUMPS[J,SINTHETA]);
09200 DY←HUMPS[J,SIGNY]*ABS(HUMPS[J,COSTHETA]);
09300 IF WHICH_END=13 THEN
09400 BEGIN DX←-DX; DY←-DY; END;
09500 HUMPS[J,DIRSIN]←DX;
09600 HUMPS[J,DIRCOS]←DY;
09700 IF TEST_ONE_LINE(N,J,X,Y) THEN RETURN(-1);
09800 IF (X-XC)↑2+(Y-YC)↑2<NDRSQ THEN
09900 BEGIN
10000 HUMPS[N,XEND]←HUMPS[J,WHICH_END]←X;
10100 HUMPS[N,YEND]←HUMPS[J,WHICH_END+1]←Y;
10200 HUMPS[N,VEND]←HUMPS[J,VER_END]←NVERT+1;
10300 VERTEX[NVERT+1,3]←2;
10400 GO TO AFT2;
10500 END;
10600 RETURN(0);
10700 END;
10800 IF NUM_VERT=0∧I=2 THEN
10900 ⊃ THIS IS THE CASE OF THREE LINES WHICH MAY INTERSECT IN ONE POINT;
11000 LOOK4: BEGIN "FOUR"
11100 J1←ENDSAVE[1,1];
11200 J2←ENDSAVE[2,1];
11300 IF VERT_THREE(N,J1,J2,X,Y,VERT_GAP) THEN GO TO AFT1;
11400 FOR J←J1,J2 DO
11500 IF TEST_ONE_LINE(N,J,X,Y) THEN RETURN(-1);
11600 RETURN(0);
11700 END "FOUR";
11800 LOOK5: IF NUM_VERT=0∧I=0 THEN
11900 ⊃ HERE WE LOOK FOR THE POSSIBILITY OF THIS LINE INTERCEPTING
12000 A SOLID LINE WHICH HAS NO END POINT INSIDE THE CIRCLE;
12100 FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
12200 BEGIN "LINE_PT"
12300 IF J=N THEN CONTINUE;
12400 IF ABS(XC*HUMPS[J,COSTHETA]+YC*HUMPS[J,SINTHETA]
12500 +HUMPS[J,CEE])>NDRAD THEN CONTINUE;
12600 ⊃ OUTSTR(CRLF&" IN LOOK5 ");
12700 X←HUMPS[J,FPOINT+1]; XNJ1←HUMPS[J,HUMPS[J,6]+1];
12800 Y←HUMPS[J,FPOINT+2]; YNJ1←HUMPS[J,HUMPS[J,6]+2];
12900 LSQ←(XNJ1-X)↑2+(YNJ1-Y)↑2;
13000 IF (X-XC)↑2+(Y-YC)↑2>LSQ∨(XNJ1-XC)↑2+(YNJ1-YC)↑2>LSQ
13100 THEN CONTINUE;
13200 IF DIS_EYE THEN SHOWCIR(XC,YC,NDRAD);
13300 ⊃ Display lines with circle;
13400 IF DISP_VERT THEN OUTSTR(CRLF&" IN LOOK5:
13500 LINE "&CVS(J)&" GOES THRU THE CIRCLE");
13600 IF TEST_ONE_LINE(N,J,X,Y) THEN RETURN(-1);
13700 IF (X-XC)↑2+(Y-YC)↑2>NDRSQ THEN RETURN(0);
13800 HUMPS[N,XEND]←X; HUMPS[N,YEND]←Y;
13900 HUMPS[N,VEND]←NVERT+1;
14000 VERTEX[NVERT+1,3]←2;
14100 GO TO AFT2;
14200 END "LINE_PT";
14300 LOOK6: IF NUM_VERT=1 THEN
14400 ⊃ HERE WE ARE LOOKING TO SEE IF THIS LINE TERMINATES
14500 IN THIS ONE VERTEX;
14600 BEGIN
14700 IF VERTEX[VSAVE,3]=2 THEN
14800 BEGIN
14900 J1←VERTEX[VSAVE,4];
15000 J2←VERTEX[VSAVE,5];
15100 IF ¬VERT_THREE(N,J1,J2,X,Y,VERT_GAP) THEN RETURN(0);
15200 VERTEX[VSAVE,1]←X;
15300 VERTEX[VSAVE,2]←Y;
15400 VERTEX[VSAVE,VERTGAP]←VERT_GAP;
15500 FOR K←J1,J2 DO
15600 IF (X-HUMPS[K,FPOINT+1])↑2+(Y-HUMPS[K,FPOINT+2])↑2
15700 <(X-HUMPS[K,HUMPS[K,6]+1])↑2+(Y-HUMPS[K,HUMPS[K,6]+2])↑2 THEN
15800 BEGIN
15900 HUMPS[K,3]←VSAVE;
16000 HUMPS[K,13]←X;
16100 HUMPS[K,14]←Y;
16200 END ELSE
16300 BEGIN
16400 HUMPS[K,4]←VSAVE;
16500 HUMPS[K,15]←X;
16600 HUMPS[K,16]←Y;
16700 END;
16800 GO TO CONECT;
16900 END;
17000 ⊃ OUTSTR(CRLF&" IN LOOK6 ");
17100 IF ABS(VERTEX[VSAVE,1]*HUMPS[N,COSTHETA]
17200 +VERTEX[VSAVE,2]*HUMPS[N,SINTHETA]
17300 +HUMPS[N,CEE])>NDACC THEN RETURN(0);
17400 CONECT: VERTEX[VSAVE,VERTEX[VSAVE,3]+4]←N;
17500 VERTEX[VSAVE,3]←VERTEX[VSAVE,3]+1;
17600 HUMPS[N,XEND]←VERTEX[VSAVE,1];
17700 HUMPS[N,YEND]←VERTEX[VSAVE,2];
17800 HUMPS[N,VEND]←VSAVE;
17900 IF DIS_EYE THEN SHOW;
18000 END;
18100 GO TO PRIN;
18200 AFT1: HUMPS[N,XEND]←X;
18300 HUMPS[N,YEND]←Y;
18400 HUMPS[N,VEND]←NVERT+1;
18500 HUMPS[J1,ENDSAVE[1,3]]←X;
18600 HUMPS[J1,ENDSAVE[1,3]+1]←Y;
18700 HUMPS[J1,ENDSAVE[1,4]]←NVERT+1;
18800 HUMPS[J2,ENDSAVE[2,3]]←X;
18900 HUMPS[J2,ENDSAVE[2,3]+1]←Y;
19000 HUMPS[J2,ENDSAVE[2,4]]←NVERT+1;
19100 VERTEX[NVERT+1,3]←3;
19200 VERTEX[NVERT+1,6]←J2;
19300 VERTEX[NVERT+1,VERTGAP]←VERT_GAP;
19400 J←J1;
19500 AFT2: NVERT←NVERT+1;
19600 VERTEX[NVERT,1]←X;
19700 VERTEX[NVERT,2]←Y;
19800 VERTEX[NVERT,4]←N;
19900 VERTEX[NVERT,5]←J;
20000 IF DIS_EYE THEN SHOW;
20100 PRIN: RETURN(0);
20200 END "EXT_ONE";
20300
00100
00200 PROCEDURE EXTEND;
00300 BEGIN "EXT"
00400 SHORT INTEGER N,K,J;
00500 BOOLEAN WHICHEND;
00600 LABEL FIRST,SECOND,FIR,AFTER,VVLAST;
00700
00800 FIRST: NDRAD←NDRADIUS;
00900 NDRSQ←NDRAD*NDRAD;
01000 BIT_FACTOR←2↑(BITS-4);
01100 NHUMPS←NLINES; NVERT←NVERTEX;
01200
01300 SECOND: FOR N←0 STEP 1 UNTIL NHUMPS-1 DO
01400 BEGIN "CYCLE"
01500 FIR: IF HUMPS[N,13]<0 THEN
01600 BEGIN
01700 WHICHEND←-1;
01800 IF EXT_ONE(N,WHICHEND) THEN GO TO AFTER;
01900 END;
02000 IF HUMPS[N,15]<0 THEN
02100 BEGIN
02200 WHICHEND←0;
02300 IF EXT_ONE(N,WHICHEND) THEN GO TO AFTER;
02400 END;
02500 CONTINUE;
02600
02700 ⊃ FOR K←0 STEP 1 UNTIL NHUMPS-1 DO
02800 OUTSTR(CRLF&" LINE "&CVS(K)
02900 &" X1="&CVG(HUMPS[K,13])
03000 &" Y1="&CVG(HUMPS[K,14])
03100 &" X2="&CVG(HUMPS[K,15])
03200 &" Y2="&CVG(HUMPS[K,16]));
03300 ⊃ FOR K←1 STEP 1 UNTIL NVERT DO
03400 OUTSTR(CRLF&"VERTEX "&CVS(K)
03500 &" XV="&CVG(VERTEX[K,1])
03600 &" YV="&CVG(VERTEX[K,2])
03700 &" NO. OF VERT.="&CVS(VERTEX[K,3])
03800 &" V1="&CVS(VERTEX[K,4])
03900 &" V2="&CVS(VERTEX[K,5])
04000 &" V3="&CVS(VERTEX[K,6]));
04100 AFTER: IF N=0 THEN GO TO FIR ELSE N←N-1;
04200 END "CYCLE";
04300 IF ¬DIS_EYE THEN GO TO VVLAST;
04400 DPYSET(BUF);
04500 AIVECT(-400,420);
04600 DPYSST("NUMBER OF LINES = "&CVS(NHUMPS)
04700 &", NUMBER OF VERTICES = "&CVS(NVERT));
04800 BOUNDARY(X1,Y2,X2,Y1);
04900 FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
05000 LINE_DISP(J);
05100 IF CAL_COMP THEN CALCOMP("EXTLIN",BUF);
05200 DPYOUT(1);
05300 VVLAST: NLINES←NHUMPS; NVERTEX←NVERT;
05400 END "EXT";
00100
00200 PROCEDURE INITIAL;
00300
00400 ⊃ Here we set up and update initial parameters;
00500
00600 BEGIN "INITIAL"
00700 SHORT INTEGER TEMP,I;
00800 SHORT REAL X,Y;
00900 LABEL OTHER;
01000 NHUMPS←MINHUMPS←NLINES; NVERT←NVERTEX;
01100 LINE_INDEX ← EBS;
01200
01300 IF NHUMPS≠0 THEN FOR I←0 STEP 1 UNTIL NHUMPS-1 DO
01400 BEGIN
01500 X←HUMPS[I,FPOINT+1]; Y←HUMPS[I,FPOINT+2];
01600 TEMP←-1;
01700 OTHER: IF X<X1 THEN X1←X;
01800 IF X>X2 THEN X2←X;
01900 IF Y<Y1 THEN Y1←Y;
02000 IF Y>Y2 THEN Y2←Y;
02100 IF TEMP<0 THEN
02200 BEGIN
02300 X←HUMPS[I,HUMPS[I,6]+1];
02400 Y←HUMPS[I,HUMPS[I,6]+2];
02500 TEMP←1;
02600 GO TO OTHER;
02700 END;
02800 END;
02900
03000
03100 ⊃ PARAMETER FOR FINDING PEAKS IN THETA-C SPACE;
03200 NMIN ← 1; ⊃ NMIN SETS MINIMUM NUMBER OF POINTS FOR
03300 PROGRAM TO LOOK FOR HISTOGRAM PEAK;
03400
03500 NDTH2←2.*NDTH; NDC2←2.*NDC;
03600 NDS3←3*NDS; NDS32←1.5*NDS; NHIGH_1←NHIGH-1;
03700 MAXR←200 DIV NDRES; IF MAXR>400 THEN MAXR←400;
03800 IF NDRES>1 THEN RHIGH←1 ELSE RHIGH←2;
03900 MAXDR←MAXR DIV 20;
04000 MINRES←MAXR DIV 10; MAXRES←MAXR-MINRES;
04100 THFACTOR←24.*(.15/NDTH);
04200 CFACTOR ← (50./DXY)*(22.5/NDC);
04300 MAXC←101*(22.5/NDC);
04400 MAXT←150*(.15/NDTH);
04500 END "INITIAL";
04600
00100
00200
00300 PROCEDURE GET_LINES;
00400
00500 BEGIN "GETL"
00600 SHORT INTEGER N,J;
00700 LABEL START,DL,VVLAST,CON;
00800 ⊃ RECYCLE THRU THE EDGE_POINTS LOOKING FOR PEAKS UNTIL NO
00900 NEW PEAKS ARE FOUND;
01000
01100 INITIAL;
01200 START: NPEAKS←0; IF ¬HIST_TH THEN GO TO DL;
01300 IF ¬HISTC THEN GO TO DL;
01400 IF LINER THEN GO TO START;
01500 DL: LEDGE_INDEX ←LINE_INDEX DIV EDGE_BLSIZE;
01600 IF ¬DIS_EYE THEN GO TO CON;
01700 DPYSET(BUF);
01800 AIVECT(-300,420);
01900 DPYSST("NUMBER OF LINES FOUND = "&CVS(NHUMPS));
02000 INIT_DOMAIN(X1,Y2,X2,Y1);
02100 BOUNDARY(X1,Y2,X2,Y1);
02200 EDGE_DISP(-1,LEDGE_INDEX,X1,Y1,X2,Y2,EDGES);
02300 ⊃ THIS WILL RESULT IN A DISPLAY OF THE LINE EDGE_POINTS;
02400 DPYOUT(1);
02500 IF CAL2_COMP THEN CALCOMP("NEWLEDG",BUF)
02600 ELSE IF CAL_COMP THEN CALCOMP("LINEDG",BUF);
02700 CON: FOR N←NLINES STEP 1 UNTIL NHUMPS-1 DO
02800 CONNECT(N);
02900 IF ¬DIS_EYE THEN GO TO VVLAST;
03000 DPYSET(BUF);
03100 AIVECT(-300,420);
03200 DPYSST("NUMBER OF LINES FOUND = "&CVS(NHUMPS));
03300 BOUNDARY(X1,Y2,X2,Y1);
03400 FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
03500 LINE_DISP(J);
03600 IF CAL2_COMP THEN CALCOMP("NEWLIN",BUF)
03700 ELSE IF CAL_COMP THEN CALCOMP("LINES",BUF);
03800 DPYOUT(1);
03900 VVLAST: NLINES←NHUMPS; NVERTEX←NVERT;
04000
04100 END "GETL";
04200
00100
00200
00300
00400 PROCEDURE GET_SOME_LINES(SHORT REAL ALPHA,DALPH);
00500
00600 ⊃ Here we accept lines with angles near ALPHA;
00700
00800
00900 BEGIN "GETS"
01000 SHORT INTEGER N,J;
01100 SHORT REAL ANG;
01200 LABEL VVLAST,CON;
01300
01400 INITIAL;
01500 NPEAKS←0; IF ¬HIST_TH THEN RETURN;
01600 FOR N←0 STEP 1 UNTIL NPEAKS-1 DO
01700 BEGIN
01800 ANG←ABS(PEAKS[N]-ALPHA);
01900 WHILE ANG>PIO2 DO
02000 ANG←ANG-PI1;
02100 IF ABS(ANG)>DALPH+.1 THEN
02200 BEGIN
02300 PEAKS[N]←PEAKS[NPEAKS-1];
02400 NPEAKS←NPEAKS-1;
02500 IF N≠NPEAKS THEN N←N-1;
02600 END;
02700 END;
02800 IF NPEAKS=0 THEN RETURN;
02900 IF ¬HISTC THEN RETURN;
03000 IF ¬LINER THEN RETURN;
03100 LEDGE_INDEX ←LINE_INDEX DIV EDGE_BLSIZE;
03200 IF ¬DIS_EYE THEN GO TO CON;
03300 DPYSET(BUF);
03400 AIVECT(-300,420);
03500 DPYSST("NUMBER OF NEW LINES FOUND = "&CVS(NHUMPS-NLINES));
03600 INIT_DOMAIN(X1,Y2,X2,Y1);
03700 BOUNDARY(X1,Y2,X2,Y1);
03800 EDGE_DISP(-1,LEDGE_INDEX,X1,Y1,X2,Y2,EDGES);
03900 ⊃ THIS WILL RESULT IN A DISPLAY OF THE LINE EDGE_POINTS;
04000 DPYOUT(1);
04100 CON: FOR N←NLINES STEP 1 UNTIL NHUMPS-1 DO
04200 CONNECT(N);
04300 IF ¬DIS_EYE THEN GO TO VVLAST;
04400 DPYSET(BUF);
04500 AIVECT(-300,420);
04600 DPYSST("NUMBER OF LINES FOUND = "&CVS(NHUMPS));
04700 BOUNDARY(X1,Y2,X2,Y1);
04800 FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
04900 LINE_DISP(J);
05000 IF CAL2_COMP THEN CALCOMP("NEWLIN",BUF);
05100 DPYOUT(1);
05200 VVLAST: NLINES←NHUMPS; NVERTEX←NVERT;
05300
05400 END "GETS";
05500